gnu: r-wgcna: Move to (gnu packages bioconductor).

[jackhill/guix/guix.git] / gnu / installer / keymap.scm

diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm
index 78065aa..c42b308 100644 (file)
--- a/gnu/installer/keymap.scm
+++ b/gnu/installer/keymap.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,6 +37,7 @@
             make-x11-keymap-layout
             x11-keymap-layout?
             x11-keymap-layout-name
+            x11-keymap-layout-synopsis
             x11-keymap-layout-description
             x11-keymap-layout-variants
 
@@ -46,6 +48,7 @@
             x11-keymap-variant-name
             x11-keymap-variant-description
 
+            default-keyboard-model
             xkb-rules->models+layouts
             kmscon-update-keymap))
 
@@ -59,7 +62,8 @@
   x11-keymap-layout make-x11-keymap-layout
   x11-keymap-layout?
   (name            x11-keymap-layout-name) ;string
-  (description     x11-keymap-layout-description) ;string
+  (synopsis        x11-keymap-layout-synopsis)    ;string (e.g., "en")
+  (description     x11-keymap-layout-description) ;string (a whole phrase)
   (variants        x11-keymap-layout-variants)) ;list of <x11-keymap-variant>
 
 (define-record-type* <x11-keymap-variant>
@@ -68,6 +72,9 @@
   (name            x11-keymap-variant-name) ;string
   (description     x11-keymap-variant-description)) ;string
 
+;; Assume all modern keyboards have this model.
+(define default-keyboard-model (make-parameter "pc105"))
+
 (define (xkb-rules->models+layouts file)
   "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL
 and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard
@@ -113,6 +120,8 @@ Configuration Database, describing possible XKB configurations."
                   (variantList ,[variant -> v] ...))
                  (x11-keymap-layout
                   (name name)
+                  (synopsis (car
+                             (assoc-ref rest-layout 'shortDescription)))
                   (description (car
                                 (assoc-ref rest-layout 'description)))
                   (variants (list v ...)))]
@@ -122,6 +131,8 @@ Configuration Database, describing possible XKB configurations."
                    . ,rest-layout))
                  (x11-keymap-layout
                   (name name)
+                  (synopsis (car
+                             (assoc-ref rest-layout 'shortDescription)))
                   (description (car
                                 (assoc-ref rest-layout 'description)))
                   (variants '()))]))
@@ -144,19 +155,28 @@ Configuration Database, describing possible XKB configurations."
       ((models layouts)
        (values models layouts)))))
 
-(define (kmscon-update-keymap model layout variant)
-  (let ((keymap-file (getenv "KEYMAP_UPDATE")))
-    (unless (and keymap-file
-                 (file-exists? keymap-file))
-      (error "Unable to locate keymap update file"))
+(define (kmscon-update-keymap model layout variant options)
+  "Update kmscon keymap with the provided MODEL, LAYOUT, VARIANT and OPTIONS."
+  (and=>
+   (getenv "KEYMAP_UPDATE")
+   (lambda (keymap-file)
+     (unless (file-exists? keymap-file)
+       (error "Unable to locate keymap update file"))
+
+     ;; See file gnu/packages/patches/kmscon-runtime-keymap-switch.patch.
+     ;; This dirty hack makes possible to update kmscon keymap at runtime by
+     ;; writing an X11 keyboard model, layout and variant to a named pipe
+     ;; referred by KEYMAP_UPDATE environment variable.
+     (call-with-output-file keymap-file
+       (lambda (port)
+         (format port model)
+         (put-u8 port 0)
 
-    (call-with-output-file keymap-file
-        (lambda (port)
-          (format port model)
-          (put-u8 port 0)
+         (format port layout)
+         (put-u8 port 0)
 
-          (format port layout)
-          (put-u8 port 0)
+         (format port (or variant ""))
+         (put-u8 port 0)
 
-          (format port variant)
-          (put-u8 port 0)))))
+         (format port (or options ""))
+         (put-u8 port 0))))))