system: Support the addition of old entries in the GRUB menu.

* gnu/system.scm (operating-system-grub.cfg): Add 'old-entries'
  parameter.  Pass it to 'grub-configuration-file'.
* gnu/system/grub.scm (grub-configuration-file): Add #:old-entries
  parameter.  Honor it.
This commit is contained in:
Ludovic Courtès 2014-06-25 22:54:52 +02:00
parent 64e40dbb69
commit fe6e3fe2a5
2 changed files with 18 additions and 6 deletions

View file

@ -493,8 +493,9 @@ (define (kernel->grub-label kernel)
(package-version kernel) (package-version kernel)
" (technology preview)")) " (technology preview)"))
(define (operating-system-grub.cfg os) (define* (operating-system-grub.cfg os #:optional (old-entries '()))
"Return the GRUB configuration file for OS." "Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate the
\"old entries\" menu."
(mlet* %store-monad (mlet* %store-monad
((system (operating-system-derivation os)) ((system (operating-system-derivation os))
(root-fs -> (operating-system-root-file-system os)) (root-fs -> (operating-system-root-file-system os))
@ -509,7 +510,8 @@ (define (operating-system-grub.cfg os)
#~(string-append "--load=" #$system #~(string-append "--load=" #$system
"/boot"))) "/boot")))
(initrd #~(string-append #$system "/initrd")))))) (initrd #~(string-append #$system "/initrd"))))))
(grub-configuration-file (operating-system-bootloader os) entries))) (grub-configuration-file (operating-system-bootloader os) entries
#:old-entries old-entries)))
(define (operating-system-parameters-file os) (define (operating-system-parameters-file os)
"Return a file that describes the boot parameters of OS. The primary use of "Return a file that describes the boot parameters of OS. The primary use of

View file

@ -63,9 +63,12 @@ (define-record-type* <menu-entry>
(initrd menu-entry-initrd)) ; file name of the initrd as a gexp (initrd menu-entry-initrd)) ; file name of the initrd as a gexp
(define* (grub-configuration-file config entries (define* (grub-configuration-file config entries
#:key (system (%current-system))) #:key
(system (%current-system))
(old-entries '()))
"Return the GRUB configuration file corresponding to CONFIG, a "Return the GRUB configuration file corresponding to CONFIG, a
<grub-configuration> object." <grub-configuration> object. OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system."
(define all-entries (define all-entries
(append entries (grub-configuration-menu-entries config))) (append entries (grub-configuration-menu-entries config)))
@ -93,7 +96,14 @@ (define builder
(($ <menu-entry> _ linux) (($ <menu-entry> _ linux)
linux)) linux))
all-entries)) all-entries))
#$@(map entry->gexp all-entries)))) #$@(map entry->gexp all-entries)
#$@(if (pair? old-entries)
#~((format port "
submenu \"GNU system, old configurations...\" {~%")
#$@(map entry->gexp old-entries)
(format port "}~%"))
#~()))))
(gexp->derivation "grub.cfg" builder)) (gexp->derivation "grub.cfg" builder))