projects/guix·blob python-team · refs

223 lines · 8.7 KiB

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