diff options
Diffstat (limited to 'gnu/bootloader/grub.scm')
| -rw-r--r-- | gnu/bootloader/grub.scm | 77 |
1 files changed, 30 insertions, 47 deletions
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 49616b7164..f1cc3324db 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -66,12 +66,15 @@ (define (strip-mount-point mount-point file) "Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object denoting a file name." - (if (string=? mount-point "/") - file - #~(let ((file #$file)) - (if (string-prefix? #$mount-point file) - (substring #$file #$(string-length mount-point)) - file)))) + (match mount-point + ((? string? mount-point) + (if (string=? mount-point "/") + file + #~(let ((file #$file)) + (if (string-prefix? #$mount-point file) + (substring #$file #$(string-length mount-point)) + file)))) + (#f file))) (define-record-type* <grub-image> grub-image make-grub-image @@ -103,19 +106,6 @@ denoting a file name." (color-highlight '((fg . yellow) (bg . black))) (color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030 -(define-record-type* <menu-entry> - menu-entry make-menu-entry - menu-entry? - (label menu-entry-label) - (device menu-entry-device ; file system uuid, label, or #f - (default #f)) - (device-mount-point menu-entry-device-mount-point - (default "/")) - (linux menu-entry-linux) - (linux-arguments menu-entry-linux-arguments - (default '())) ; list of string-valued gexps - (initrd menu-entry-initrd)) ; file name of the initrd as a gexp - ;;; ;;; Background image & themes. @@ -312,16 +302,6 @@ code." (#f #~(format #f "search --file --set ~a" #$file))))) -(define (boot-parameters->menu-entry conf) - "Convert a <boot-parameters> instance to a corresponding <menu-entry>." - (menu-entry - (label (boot-parameters-label conf)) - (device (boot-parameters-store-device conf)) - (device-mount-point (boot-parameters-store-mount-point conf)) - (linux (boot-parameters-kernel conf)) - (linux-arguments (boot-parameters-kernel-arguments conf)) - (initrd (boot-parameters-initrd conf)))) - (define* (grub-configuration-file config entries #:key (system (%current-system)) @@ -331,33 +311,36 @@ code." STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu entries corresponding to old generations of the system." (define all-entries - (map boot-parameters->menu-entry - (append entries - (bootloader-configuration-menu-entries config)))) - - (define entry->gexp - (match-lambda - (($ <menu-entry> label device device-mount-point - linux arguments initrd) + (append entries (map menu-entry->boot-parameters + (bootloader-configuration-menu-entries config)))) + + (define (boot-parameters->gexp params) + (let ((device (boot-parameters-store-device params)) + (device-mount-point (boot-parameters-store-mount-point params)) + (label (boot-parameters-label params)) + (kernel (boot-parameters-kernel params)) + (arguments (boot-parameters-kernel-arguments params)) + (initrd (boot-parameters-initrd params))) ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point. - ;; Use the right file names for LINUX and INITRD in case + ;; Use the right file names for KERNEL and INITRD in case ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a ;; separate partition. - (let ((linux (strip-mount-point device-mount-point linux)) - (initrd (strip-mount-point device-mount-point initrd))) + (let ((kernel (strip-mount-point device-mount-point kernel)) + (initrd (strip-mount-point device-mount-point initrd))) #~(format port "menuentry ~s { ~a linux ~a ~a initrd ~a }~%" #$label - #$(grub-root-search device linux) - #$linux (string-join (list #$@arguments)) - #$initrd))))) + #$(grub-root-search device kernel) + #$kernel (string-join (list #$@arguments)) + #$initrd)))) (mlet %store-monad ((sugar (eye-candy config - (menu-entry-device (first all-entries)) - (menu-entry-device-mount-point + (boot-parameters-store-device + (first all-entries)) + (boot-parameters-store-mount-point (first all-entries)) #:system system #:port #~port))) @@ -374,12 +357,12 @@ set default=~a set timeout=~a~%" #$(bootloader-configuration-default-entry config) #$(bootloader-configuration-timeout config)) - #$@(map entry->gexp all-entries) + #$@(map boot-parameters->gexp all-entries) #$@(if (pair? old-entries) #~((format port " submenu \"GNU system, old configurations...\" {~%") - #$@(map entry->gexp (map boot-parameters->menu-entry old-entries)) + #$@(map boot-parameters->gexp old-entries) (format port "}~%")) #~())))) |