Commit | Line | Data |
---|---|---|
d0f3a672 | 1 | ;;; GNU Guix --- Functional package management for GNU |
786c9c39 | 2 | ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com> |
3191b5f6 | 3 | ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> |
91c231a2 | 4 | ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de> |
d0f3a672 MO |
5 | ;;; |
6 | ;;; This file is part of GNU Guix. | |
7 | ;;; | |
8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
9 | ;;; under the terms of the GNU General Public License as published by | |
10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
11 | ;;; your option) any later version. | |
12 | ;;; | |
13 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;;; GNU General Public License for more details. | |
17 | ;;; | |
18 | ;;; You should have received a copy of the GNU General Public License | |
19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | (define-module (gnu installer newt keymap) | |
22 | #:use-module (gnu installer keymap) | |
23 | #:use-module (gnu installer steps) | |
24 | #:use-module (gnu installer newt page) | |
25 | #:use-module (guix i18n) | |
26 | #:use-module (guix records) | |
27 | #:use-module (newt) | |
28 | #:use-module (srfi srfi-1) | |
cb614af0 | 29 | #:use-module (srfi srfi-26) |
d0f3a672 MO |
30 | #:use-module (srfi srfi-34) |
31 | #:use-module (srfi srfi-35) | |
9015e639 | 32 | #:use-module (ice-9 i18n) |
3191b5f6 LC |
33 | #:use-module (ice-9 match) |
34 | #:export (run-keymap-page | |
35 | keyboard-layout->configuration)) | |
d0f3a672 | 36 | |
786c9c39 | 37 | (define (run-layout-page layouts layout->text context) |
5cdb6bd2 | 38 | (let ((title (G_ "Layout"))) |
d0f3a672 MO |
39 | (run-listbox-selection-page |
40 | #:title title | |
786c9c39 MO |
41 | #:info-text |
42 | (case context | |
07a53bd5 | 43 | ((param) (G_ "Please choose your keyboard layout. \ |
91c231a2 FP |
44 | It will only be used during the installation process. \ |
45 | Non-Latin layouts can be toggled with Alt+Shift.")) | |
786c9c39 MO |
46 | (else (G_ "Please choose your keyboard layout. \ |
47 | It will be used during the install process, and for the installed system. \ | |
91c231a2 FP |
48 | Non-Latin layouts can be toggled with Alt+Shift. You can switch to a \ |
49 | different layout at any time from the parameters menu."))) | |
d0f3a672 MO |
50 | #:listbox-items layouts |
51 | #:listbox-item->text layout->text | |
cb614af0 | 52 | #:sort-listbox-items? #f |
786c9c39 MO |
53 | #:button-text |
54 | (case context | |
07a53bd5 | 55 | ((param) (G_ "Continue")) |
786c9c39 | 56 | (else (G_ "Exit"))) |
d0f3a672 | 57 | #:button-callback-procedure |
786c9c39 | 58 | (case context |
07a53bd5 | 59 | ((param) (const #t)) |
786c9c39 MO |
60 | (else |
61 | (lambda _ | |
62 | (raise | |
63 | (condition | |
64 | (&installer-step-abort))))))))) | |
d0f3a672 MO |
65 | |
66 | (define (run-variant-page variants variant->text) | |
5cdb6bd2 | 67 | (let ((title (G_ "Variant"))) |
d0f3a672 MO |
68 | (run-listbox-selection-page |
69 | #:title title | |
70 | #:info-text (G_ "Please choose a variant for your keyboard layout.") | |
71 | #:listbox-items variants | |
72 | #:listbox-item->text variant->text | |
cb614af0 | 73 | #:sort-listbox-items? #f |
d0f3a672 MO |
74 | #:button-text (G_ "Back") |
75 | #:button-callback-procedure | |
76 | (lambda _ | |
77 | (raise | |
78 | (condition | |
79 | (&installer-step-abort))))))) | |
80 | ||
cb614af0 MO |
81 | (define (sort-layouts layouts) |
82 | "Sort LAYOUTS list by putting the US layout ahead and return it." | |
9015e639 LC |
83 | (define (layout<? layout1 layout2) |
84 | (let ((text1 (x11-keymap-layout-description layout1)) | |
85 | (text2 (x11-keymap-layout-description layout2))) | |
86 | ;; XXX: We're calling 'gettext' more than once per item. | |
87 | (string-locale<? (gettext text1 "xkeyboard-config") | |
88 | (gettext text2 "xkeyboard-config")))) | |
89 | ||
90 | (define preferred | |
91 | ;; Two-letter language tag for the preferred keyboard layout. | |
92 | (or (getenv "LANGUAGE") "us")) | |
93 | ||
cb614af0 MO |
94 | (call-with-values |
95 | (lambda () | |
96 | (partition | |
97 | (lambda (layout) | |
9015e639 LC |
98 | ;; The 'synopsis' field is usually a language code (e.g., "en") |
99 | ;; while the 'name' field is a country code (e.g., "us"). | |
100 | (or (string=? (x11-keymap-layout-name layout) preferred) | |
101 | (string=? (x11-keymap-layout-synopsis layout) preferred))) | |
cb614af0 | 102 | layouts)) |
9015e639 LC |
103 | (lambda (main others) |
104 | (append (sort main layout<?) | |
105 | (sort others layout<?))))) | |
cb614af0 | 106 | |
7bc71025 FP |
107 | (define (add-empty-variant variants) |
108 | "Prepend #f to VARIANTS so the user has the option to select no variant. | |
109 | The resulting layout may be different from all other variants (e.g. for | |
110 | Azerbaijani)." | |
111 | (cons #f variants)) | |
112 | ||
cb614af0 | 113 | (define (sort-variants variants) |
b83e4a93 | 114 | "Sort VARIANTS list by putting the international variant ahead and return it." |
cb614af0 MO |
115 | (call-with-values |
116 | (lambda () | |
117 | (partition | |
118 | (lambda (variant) | |
7bc71025 FP |
119 | (and variant |
120 | (let ((name (x11-keymap-variant-name variant))) | |
121 | (string=? name "altgr-intl")))) | |
cb614af0 MO |
122 | variants)) |
123 | (cut append <> <>))) | |
124 | ||
91c231a2 FP |
125 | (define %non-latin-layouts |
126 | ;; List of keyboard layouts marked as $nonlatin in xkeyboard-config. | |
127 | ;; See comments in xkeyboard-config file /share/X11/xkb/rules/base. | |
128 | ;; We ignore layouts that support Latin input: "kr" | |
129 | '("am" "ara" "ben" "bd" "bg" "bt" "by" "cs" "deva" "ge" "gh" | |
130 | "gr" "guj" "guru" "il" "in" "ir" "iku" "jp" "kan" "kh" | |
131 | "la" "lao" "lk" "mk" "mm" "mn" "mv" "mal" "olck" "ori" "pk" | |
132 | "ru" "scc" "sy" "syr" "tel" "th" "tj" "tam" "ua" "uz" | |
133 | ;; The list from xkeyboard-config is incomplete. Add more layouts when | |
134 | ;; noticed: | |
135 | "et" "kz")) | |
136 | ||
137 | (define %non-latin-variants | |
138 | '("cyrillic")) | |
139 | ||
140 | (define %latin-layout+variants | |
141 | ;; These layout+variant combinations are Latin after all. | |
142 | '(("ir" "ku"))) | |
143 | ||
144 | (define (toggleable-latin-layout layout variant) | |
145 | "If LAYOUT is a non-Latin layout, return a new combined layout, | |
146 | a variant, and options that allow the user to switch between the | |
147 | non-Latin and the Latin layout. Otherwise, return LAYOUT, VARIANT, | |
148 | and #f." | |
149 | (if (and (not (equal? variant "latin")) | |
150 | (not (member (list layout variant) %latin-layout+variants)) | |
151 | (or (member layout %non-latin-layouts) | |
152 | (member variant %non-latin-variants))) | |
153 | (let ((latin-layout (if (equal? variant "azerty") "fr" "us"))) | |
154 | (list | |
155 | (string-append layout "," latin-layout) | |
156 | ;; Comma to use variant only for non-Latin: | |
157 | (and variant (string-append variant ",")) | |
158 | "grp:alt_shift_toggle")) | |
159 | (list layout variant #f))) | |
160 | ||
786c9c39 | 161 | (define* (run-keymap-page layouts #:key (context #f)) |
c088b2e4 | 162 | "Run a page asking the user to select a keyboard layout and variant. LAYOUTS |
91c231a2 FP |
163 | is a list of supported X11-KEYMAP-LAYOUT. For non-Latin keyboard layouts, a |
164 | second layout and toggle options will be added automatically. Return a list | |
165 | of three elements, the names of the selected keyboard layout, variant and | |
166 | options." | |
d0f3a672 MO |
167 | (define keymap-steps |
168 | (list | |
d0f3a672 MO |
169 | (installer-step |
170 | (id 'layout) | |
171 | (compute | |
172 | (lambda _ | |
9e58d4e9 | 173 | (run-layout-page |
cb614af0 | 174 | (sort-layouts layouts) |
9e58d4e9 | 175 | (lambda (layout) |
feaa83a3 | 176 | (gettext (x11-keymap-layout-description layout) |
786c9c39 MO |
177 | "xkeyboard-config")) |
178 | context)))) | |
d0f3a672 MO |
179 | ;; Propose the user to select a variant among those supported by the |
180 | ;; previously selected layout. | |
181 | (installer-step | |
182 | (id 'variant) | |
183 | (compute | |
54754efc | 184 | (lambda (result _) |
9e58d4e9 MO |
185 | (let* ((layout (result-step result 'layout)) |
186 | (variants (x11-keymap-layout-variants layout))) | |
187 | ;; Return #f if the layout does not have any variant. | |
188 | (and (not (null? variants)) | |
cb614af0 | 189 | (run-variant-page |
7bc71025 | 190 | (sort-variants (add-empty-variant variants)) |
cb614af0 | 191 | (lambda (variant) |
7bc71025 FP |
192 | (if variant |
193 | (gettext (x11-keymap-variant-description variant) | |
194 | "xkeyboard-config") | |
195 | ;; Text to opt for no variant at all: | |
196 | (gettext (x11-keymap-layout-description layout) | |
197 | "xkeyboard-config"))))))))))) | |
d0f3a672 MO |
198 | |
199 | (define (format-result result) | |
c088b2e4 | 200 | (let ((layout (x11-keymap-layout-name |
d0f3a672 MO |
201 | (result-step result 'layout))) |
202 | (variant (and=> (result-step result 'variant) | |
203 | (lambda (variant) | |
feaa83a3 LC |
204 | (gettext (x11-keymap-variant-name variant) |
205 | "xkeyboard-config"))))) | |
91c231a2 | 206 | (toggleable-latin-layout layout variant))) |
d0f3a672 MO |
207 | (format-result |
208 | (run-installer-steps #:steps keymap-steps))) | |
3191b5f6 LC |
209 | |
210 | (define (keyboard-layout->configuration keymap) | |
211 | "Return the operating system configuration snippet to install KEYMAP." | |
212 | (match keymap | |
91c231a2 FP |
213 | ((name #f "grp:alt_shift_toggle") |
214 | `((keyboard-layout (keyboard-layout ,name | |
215 | #:options '("grp:alt_shift_toggle"))))) | |
216 | ((name #f _) | |
3191b5f6 | 217 | `((keyboard-layout (keyboard-layout ,name)))) |
91c231a2 FP |
218 | ((name variant "grp:alt_shift_toggle") |
219 | `((keyboard-layout (keyboard-layout ,name ,variant | |
220 | #:options '("grp:alt_shift_toggle"))))) | |
221 | ((name variant _) | |
3191b5f6 | 222 | `((keyboard-layout (keyboard-layout ,name ,variant)))))) |