summary refs log tree commit diff
path: root/gnu/installer
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/keymap.scm10
-rw-r--r--gnu/installer/newt/keymap.scm82
-rw-r--r--gnu/installer/record.scm3
-rw-r--r--gnu/installer/tests.scm9
-rw-r--r--gnu/installer/utils.scm5
5 files changed, 89 insertions, 20 deletions
diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm
index df9fc5e441..c42b308009 100644
--- 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.
 ;;;
@@ -154,8 +155,8 @@ Configuration Database, describing possible XKB configurations."
       ((models layouts)
        (values models layouts)))))
 
-(define (kmscon-update-keymap model layout variant)
-  "Update kmscon keymap with the provided MODEL, LAYOUT and VARIANT."
+(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)
@@ -174,5 +175,8 @@ Configuration Database, describing possible XKB configurations."
          (format port layout)
          (put-u8 port 0)
 
-         (format port variant)
+         (format port (or variant ""))
+         (put-u8 port 0)
+
+         (format port (or options ""))
          (put-u8 port 0))))))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index 8625afaa03..1b3af2f158 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,10 +41,12 @@
      #:info-text
      (case context
        ((param) (G_ "Please choose your keyboard layout. \
-It will only be used during the installation process."))
+It will only be used during the installation process. \
+Non-Latin layouts can be toggled with Alt+Shift."))
        (else (G_ "Please choose your keyboard layout. \
 It will be used during the install process, and for the installed system. \
-You can switch to different layout at any time from the parameters menu.")))
+Non-Latin layouts can be toggled with Alt+Shift. You can switch to a \
+different layout at any time from the parameters menu.")))
      #:listbox-items layouts
      #:listbox-item->text layout->text
      #:sort-listbox-items? #f
@@ -101,21 +104,66 @@ You can switch to different layout at any time from the parameters menu.")))
       (append (sort main layout<?)
               (sort others layout<?)))))
 
+(define (add-empty-variant variants)
+  "Prepend #f to VARIANTS so the user has the option to select no variant.
+The resulting layout may be different from all other variants (e.g. for
+Azerbaijani)."
+  (cons #f variants))
+
 (define (sort-variants variants)
   "Sort VARIANTS list by putting the international variant ahead and return it."
   (call-with-values
       (lambda ()
         (partition
          (lambda (variant)
-           (let ((name (x11-keymap-variant-name variant)))
-             (string=? name "altgr-intl")))
+           (and variant
+                (let ((name (x11-keymap-variant-name variant)))
+                  (string=? name "altgr-intl"))))
          variants))
     (cut append <> <>)))
 
+(define %non-latin-layouts
+  ;; List of keyboard layouts marked as $nonlatin in xkeyboard-config.
+  ;; See comments in xkeyboard-config file /share/X11/xkb/rules/base.
+  ;; We ignore layouts that support Latin input: "kr"
+  '("am" "ara" "ben" "bd" "bg" "bt" "by" "cs" "deva" "ge" "gh"
+    "gr" "guj" "guru" "il" "in" "ir" "iku" "jp" "kan" "kh"
+    "la" "lao" "lk" "mk" "mm" "mn" "mv" "mal" "olck" "ori" "pk"
+    "ru" "scc" "sy" "syr" "tel" "th" "tj" "tam" "ua" "uz"
+    ;; The list from xkeyboard-config is incomplete.  Add more layouts when
+    ;; noticed:
+    "et" "kz"))
+
+(define %non-latin-variants
+  '("cyrillic"))
+
+(define %latin-layout+variants
+  ;; These layout+variant combinations are Latin after all.
+  '(("ir" "ku")))
+
+(define (toggleable-latin-layout layout variant)
+  "If LAYOUT is a non-Latin layout, return a new combined layout,
+a variant, and options that allow the user to switch between the
+non-Latin and the Latin layout.  Otherwise, return LAYOUT, VARIANT,
+and #f."
+  (if (and (not (equal? variant "latin"))
+           (not (member (list layout variant) %latin-layout+variants))
+           (or (member layout %non-latin-layouts)
+               (member variant %non-latin-variants)))
+      (let ((latin-layout (if (equal? variant "azerty") "fr" "us")))
+        (list
+         (string-append layout "," latin-layout)
+         ;; Comma to use variant only for non-Latin:
+         (and variant (string-append variant ","))
+         "grp:alt_shift_toggle"))
+      (list layout variant #f)))
+
 (define* (run-keymap-page layouts #:key (context #f))
   "Run a page asking the user to select a keyboard layout and variant. LAYOUTS
-is a list of supported X11-KEYMAP-LAYOUT. Return a list of two elements, the
-names of the selected keyboard layout and variant."
+is a list of supported X11-KEYMAP-LAYOUT.  For non-Latin keyboard layouts, a
+second layout and toggle options will be added automatically.  Return a list
+of three elements, the names of the selected keyboard layout, variant and
+options."
   (define keymap-steps
     (list
      (installer-step
@@ -139,10 +187,14 @@ names of the selected keyboard layout and variant."
            ;; Return #f if the layout does not have any variant.
            (and (not (null? variants))
                 (run-variant-page
-                 (sort-variants variants)
+                 (sort-variants (add-empty-variant variants))
                  (lambda (variant)
-                   (gettext (x11-keymap-variant-description variant)
-                            "xkeyboard-config"))))))))))
+                   (if variant
+                       (gettext (x11-keymap-variant-description variant)
+                                "xkeyboard-config")
+                       ;; Text to opt for no variant at all:
+                       (gettext (x11-keymap-layout-description layout)
+                                "xkeyboard-config")))))))))))
 
   (define (format-result result)
     (let ((layout (x11-keymap-layout-name
@@ -151,14 +203,20 @@ names of the selected keyboard layout and variant."
                           (lambda (variant)
                             (gettext (x11-keymap-variant-name variant)
                                      "xkeyboard-config")))))
-      (list layout (or variant ""))))
+      (toggleable-latin-layout layout variant)))
   (format-result
    (run-installer-steps #:steps keymap-steps)))
 
 (define (keyboard-layout->configuration keymap)
   "Return the operating system configuration snippet to install KEYMAP."
   (match keymap
-    ((name "")
+    ((name #f "grp:alt_shift_toggle")
+     `((keyboard-layout (keyboard-layout ,name
+                                         #:options '("grp:alt_shift_toggle")))))
+    ((name #f _)
      `((keyboard-layout (keyboard-layout ,name))))
-    ((name variant)
+    ((name variant "grp:alt_shift_toggle")
+     `((keyboard-layout (keyboard-layout ,name ,variant
+                                         #:options '("grp:alt_shift_toggle")))))
+    ((name variant _)
      `((keyboard-layout (keyboard-layout ,name ,variant))))))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 7bc22e90e0..6ebd87f6a6 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -63,7 +64,7 @@
   (exit-error installer-exit-error)
   ;; procedure void -> void
   (final-page installer-final-page)
-  ;; procedure (layouts context) -> (list layout variant)
+  ;; procedure (layouts context) -> (list layout variant options)
   (keymap-page installer-keymap-page)
   ;; procedure: (#:key supported-locales iso639-languages iso3166-territories)
   ;; -> glibc-locale
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 8ae80e4d7e..58bf0a2700 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -296,8 +296,13 @@ file, actually starting the installation process."
          encrypted
          not-encrypted))
     ((list-selection (title "Disk") (multiple-choices? #f)
-                     (items (,disk _ ...)))
-     disk)
+                     (items (,disks ...)))
+     ;; When running the installation from an ISO image, the CD/DVD drive
+     ;; shows up in the list.  Avoid it.
+     (find (lambda (disk)
+             (not (or (string-contains disk "DVD")
+                      (string-contains disk "CD-ROM"))))
+           disks))
 
     ;; The "Partition table" dialog pops up only if there's not already a
     ;; partition table.
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 0a91ae1e4a..5f8fe8ca01 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -93,7 +93,8 @@ COMMAND exited successfully, #f otherwise."
           (setenv "LC_ALL" locale)
           (setenv "LANGUAGE"
                   (string-take locale
-                               (string-index locale #\_))))))
+                               (or (string-index locale #\_)
+                                   (string-length locale)))))))
 
   (guard (c ((invoke-error? c)
              (newline)