X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/8b22107e5d0bdeb300fb33b5a40aed2057a66b94..c75e349467a943a42974abcd107a25a90facd046:/gnu/bootloader.scm

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index d5fcf30f05..01bdd4acaa 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,7 @@
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:export (menu-entry
             menu-entry?
             menu-entry-label
@@ -30,6 +32,10 @@
             menu-entry-linux
             menu-entry-linux-arguments
             menu-entry-initrd
+            menu-entry-device-mount-point
+
+            menu-entry->sexp
+            sexp->menu-entry
 
             bootloader
             bootloader?
@@ -42,10 +48,11 @@
             bootloader-configuration
             bootloader-configuration?
             bootloader-configuration-bootloader
-            bootloader-configuration-device
+            bootloader-configuration-target
             bootloader-configuration-menu-entries
             bootloader-configuration-default-entry
             bootloader-configuration-timeout
+            bootloader-configuration-keyboard-layout
             bootloader-configuration-theme
             bootloader-configuration-terminal-outputs
             bootloader-configuration-terminal-inputs
@@ -67,11 +74,42 @@
   (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 #f))
   (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
 
+(define (menu-entry->sexp entry)
+  "Return ENTRY serialized as an sexp."
+  (match entry
+    (($ <menu-entry> label device mount-point linux linux-arguments initrd)
+     `(menu-entry (version 0)
+                  (label ,label)
+                  (device ,device)
+                  (device-mount-point ,mount-point)
+                  (linux ,linux)
+                  (linux-arguments ,linux-arguments)
+                  (initrd ,initrd)))))
+
+(define (sexp->menu-entry sexp)
+  "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
+record."
+  (match sexp
+    (('menu-entry ('version 0)
+                  ('label label) ('device device)
+                  ('device-mount-point mount-point)
+                  ('linux linux) ('linux-arguments linux-arguments)
+                  ('initrd initrd) _ ...)
+     (menu-entry
+      (label label)
+      (device device)
+      (device-mount-point mount-point)
+      (linux linux)
+      (linux-arguments linux-arguments)
+      (initrd initrd)))))
+
 
 ;;;
 ;;; Bootloader record.
@@ -101,27 +139,27 @@
 (define-record-type* <bootloader-configuration>
   bootloader-configuration make-bootloader-configuration
   bootloader-configuration?
-  (bootloader                      bootloader-configuration-bootloader)    ; <bootloader>
-  (device                          bootloader-configuration-device         ; string
-                                   (default #f))
-  (menu-entries                    bootloader-configuration-menu-entries   ; list of <boot-parameters>
-                                   (default '()))
-  (default-entry                   bootloader-configuration-default-entry  ; integer
-                                   (default 0))
-  (timeout                         bootloader-configuration-timeout        ; seconds as integer
-                                   (default 5))
-  (theme                           bootloader-configuration-theme          ; bootloader-specific theme
-                                   (default #f))
-  (terminal-outputs                bootloader-configuration-terminal-outputs ; list of symbols
-                                   (default '(gfxterm)))
-  (terminal-inputs                 bootloader-configuration-terminal-inputs  ; list of symbols
-                                   (default '()))
-  (serial-unit                     bootloader-configuration-serial-unit      ; integer | #f
-                                   (default #f))
-  (serial-speed                    bootloader-configuration-serial-speed     ; integer | #f
-                                   (default #f))
-  (additional-configuration        bootloader-configuration-additional-configuration ; record
-                                   (default #f)))
+  (bootloader         bootloader-configuration-bootloader) ;<bootloader>
+  (target             bootloader-configuration-target      ;string
+                      (default #f))
+  (menu-entries       bootloader-configuration-menu-entries ;list of <menu-entry>
+                      (default '()))
+  (default-entry      bootloader-configuration-default-entry ;integer
+                      (default 0))
+  (timeout            bootloader-configuration-timeout ;seconds as integer
+                      (default 5))
+  (keyboard-layout    bootloader-configuration-keyboard-layout ;<keyboard-layout> | #f
+                      (default #f))
+  (theme              bootloader-configuration-theme ;bootloader-specific theme
+                      (default #f))
+  (terminal-outputs   bootloader-configuration-terminal-outputs ;list of symbols
+                      (default '(gfxterm)))
+  (terminal-inputs    bootloader-configuration-terminal-inputs ;list of symbols
+                      (default '()))
+  (serial-unit        bootloader-configuration-serial-unit ;integer | #f
+                      (default #f))
+  (serial-speed       bootloader-configuration-serial-speed ;integer | #f
+                      (default #f)))
 
 
 ;;;
@@ -132,7 +170,8 @@
   "Return the list of bootloader modules."
   (all-modules (map (lambda (entry)
                       `(,entry . "gnu/bootloader"))
-                    %load-path)))
+                    %load-path)
+               #:warn warn-about-load-error))
 
 (define %bootloaders
   ;; The list of publically-known bootloaders.