janneke pushed a commit to branch wip-hurd-vm in repository guix. commit 43df8616f6de5a9365df7721cd85ce5add09e895 Author: Jan (janneke) Nieuwenhuizen <jann...@gnu.org> AuthorDate: Sun May 10 13:12:09 2020 +0200
bootloader: Add `<hurd-menu-entry>'. * gnu/bootloader.scm (<hurd-menu-entry>): New record. (menu-entry->sexp,sexp->menu-entry): Support it. --- gnu/bootloader.scm | 40 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 38 insertions(+), 2 deletions(-) diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 01bdd4a..e22d863 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -34,6 +34,14 @@ menu-entry-initrd menu-entry-device-mount-point + hurd-menu-entry + hurd-menu-entry? + hurd-menu-entry-label + hurd-menu-entry-device + hurd-menu-entry-mach + hurd-menu-entry-hurd + hurd-menu-entry-device-mount-point + menu-entry->sexp sexp->menu-entry @@ -81,6 +89,17 @@ (default '())) ; list of string-valued gexps (initrd menu-entry-initrd)) ; file name of the initrd as a gexp +(define-record-type* <hurd-menu-entry> + hurd-menu-entry make-hurd-menu-entry + hurd-menu-entry? + (label hurd-menu-entry-label) + (device hurd-menu-entry-device ; file system uuid, label, or #f + (default #f)) + (device-mount-point hurd-menu-entry-device-mount-point + (default #f)) + (mach hurd-menu-entry-mach) + (hurd hurd-menu-entry-hurd)) + (define (menu-entry->sexp entry) "Return ENTRY serialized as an sexp." (match entry @@ -91,7 +110,14 @@ (device-mount-point ,mount-point) (linux ,linux) (linux-arguments ,linux-arguments) - (initrd ,initrd))))) + (initrd ,initrd))) + (($ <hurd-menu-entry> label device mount-point mach hurd) + `(hurd-menu-entry (version 0) + (label ,label) + (device ,device) + (device-mount-point ,mount-point) + (mach ,mach) + (hurd ,hurd))))) (define (sexp->menu-entry sexp) "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry> @@ -108,7 +134,17 @@ record." (device-mount-point mount-point) (linux linux) (linux-arguments linux-arguments) - (initrd initrd))))) + (initrd initrd))) + (('menu-entry ('version 0) + ('label label) ('device device) + ('device-mount-point mount-point) + ('mach mach) ('hurd hurd) _ ...) + (hurd-menu-entry + (label label) + (device device) + (device-mount-point mount-point) + (mach mach) + (hurd hurd))))) ;;;