blob: 9178a4341ac6920ab0a1416bbaffb1bf746e2a35 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer newt keymap)
#:use-module (gnu installer keymap)
#:use-module (gnu installer steps)
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (newt)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (run-keymap-page))
(define (run-layout-page layouts layout->text)
(let ((title (G_ "Layout")))
(run-listbox-selection-page
#:title title
#:info-text (G_ "Please choose your keyboard layout.")
#:listbox-items layouts
#:listbox-item->text layout->text
#:button-text (G_ "Exit")
#:button-callback-procedure
(lambda _
(raise
(condition
(&installer-step-abort)))))))
(define (run-variant-page variants variant->text)
(let ((title (G_ "Variant")))
(run-listbox-selection-page
#:title title
#:info-text (G_ "Please choose a variant for your keyboard layout.")
#:listbox-items variants
#:listbox-item->text variant->text
#:button-text (G_ "Back")
#:button-callback-procedure
(lambda _
(raise
(condition
(&installer-step-abort)))))))
(define* (run-keymap-page layouts)
"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."
(define keymap-steps
(list
(installer-step
(id 'layout)
(compute
(lambda _
(let* ((layout (run-layout-page
layouts
(lambda (layout)
(x11-keymap-layout-description layout)))))
(if (null? (x11-keymap-layout-variants layout))
;; Break if this layout does not have any variant.
(raise
(condition
(&installer-step-break)))
layout)))))
;; Propose the user to select a variant among those supported by the
;; previously selected layout.
(installer-step
(id 'variant)
(compute
(lambda (result _)
(let ((variants (x11-keymap-layout-variants
(result-step result 'layout))))
(run-variant-page variants
(lambda (variant)
(x11-keymap-variant-description
variant)))))))))
(define (format-result result)
(let ((layout (x11-keymap-layout-name
(result-step result 'layout)))
(variant (and=> (result-step result 'variant)
(lambda (variant)
(x11-keymap-variant-name variant)))))
(list layout (or variant ""))))
(format-result
(run-installer-steps #:steps keymap-steps)))
|