Commit | Line | Data |
---|---|---|
d0f3a672 | 1 | ;;; GNU Guix --- Functional package management for GNU |
d58e52b0 | 2 | ;;; Copyright © 2018, 2021 Mathieu Othacehe <othacehe@gnu.org> |
91c231a2 | 3 | ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de> |
d0f3a672 MO |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (gnu installer keymap) | |
21 | #:use-module (guix records) | |
22 | #:use-module (sxml match) | |
23 | #:use-module (sxml simple) | |
24 | #:use-module (ice-9 binary-ports) | |
25 | #:use-module (ice-9 ftw) | |
26 | #:use-module (ice-9 match) | |
27 | #:use-module (ice-9 regex) | |
28 | #:export (<x11-keymap-model> | |
29 | x11-keymap-model | |
30 | make-x11-keymap-model | |
31 | x11-keymap-model? | |
32 | x11-keymap-model-name | |
33 | x11-keymap-model-description | |
34 | ||
35 | <x11-keymap-layout> | |
36 | x11-keymap-layout | |
37 | make-x11-keymap-layout | |
38 | x11-keymap-layout? | |
39 | x11-keymap-layout-name | |
818595a9 | 40 | x11-keymap-layout-synopsis |
d0f3a672 MO |
41 | x11-keymap-layout-description |
42 | x11-keymap-layout-variants | |
43 | ||
44 | <x11-keymap-variant> | |
45 | x11-keymap-variant | |
46 | make-x11-keymap-variant | |
47 | x11-keymap-variant? | |
48 | x11-keymap-variant-name | |
49 | x11-keymap-variant-description | |
50 | ||
c088b2e4 | 51 | default-keyboard-model |
d0f3a672 MO |
52 | xkb-rules->models+layouts |
53 | kmscon-update-keymap)) | |
54 | ||
55 | (define-record-type* <x11-keymap-model> | |
56 | x11-keymap-model make-x11-keymap-model | |
57 | x11-keymap-model? | |
58 | (name x11-keymap-model-name) ;string | |
59 | (description x11-keymap-model-description)) ;string | |
60 | ||
61 | (define-record-type* <x11-keymap-layout> | |
62 | x11-keymap-layout make-x11-keymap-layout | |
63 | x11-keymap-layout? | |
64 | (name x11-keymap-layout-name) ;string | |
818595a9 LC |
65 | (synopsis x11-keymap-layout-synopsis) ;string (e.g., "en") |
66 | (description x11-keymap-layout-description) ;string (a whole phrase) | |
d0f3a672 MO |
67 | (variants x11-keymap-layout-variants)) ;list of <x11-keymap-variant> |
68 | ||
69 | (define-record-type* <x11-keymap-variant> | |
70 | x11-keymap-variant make-x11-keymap-variant | |
71 | x11-keymap-variant? | |
72 | (name x11-keymap-variant-name) ;string | |
73 | (description x11-keymap-variant-description)) ;string | |
74 | ||
c088b2e4 MO |
75 | ;; Assume all modern keyboards have this model. |
76 | (define default-keyboard-model (make-parameter "pc105")) | |
77 | ||
d0f3a672 MO |
78 | (define (xkb-rules->models+layouts file) |
79 | "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL | |
80 | and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard | |
81 | Configuration Database, describing possible XKB configurations." | |
d58e52b0 MO |
82 | (define maybe-empty |
83 | (match-lambda | |
84 | ((x) x) | |
85 | (#f ""))) | |
86 | ||
d0f3a672 MO |
87 | (define (model m) |
88 | (sxml-match m | |
89 | [(model | |
90 | (configItem | |
91 | (name ,name) | |
92 | (description ,description) | |
93 | . ,rest)) | |
94 | (x11-keymap-model | |
95 | (name name) | |
96 | (description description))])) | |
97 | ||
98 | (define (variant v) | |
99 | (sxml-match v | |
100 | [(variant | |
101 | ;; According to xbd-rules DTD, the definition of a | |
102 | ;; configItem is: <!ELEMENT configItem | |
103 | ;; (name,shortDescription*,description*,vendor?, | |
104 | ;; countryList?,languageList?,hwList?)> | |
105 | ;; | |
106 | ;; shortDescription and description are optional elements | |
107 | ;; but sxml-match does not support default values for | |
108 | ;; elements (only attributes). So to avoid writing as many | |
109 | ;; patterns as existing possibilities, gather all the | |
110 | ;; remaining elements but name in REST-VARIANT. | |
111 | (configItem | |
112 | (name ,name) | |
113 | . ,rest-variant)) | |
114 | (x11-keymap-variant | |
115 | (name name) | |
d58e52b0 | 116 | (description (maybe-empty |
d0f3a672 MO |
117 | (assoc-ref rest-variant 'description))))])) |
118 | ||
119 | (define (layout l) | |
120 | (sxml-match l | |
121 | [(layout | |
122 | (configItem | |
123 | (name ,name) | |
124 | . ,rest-layout) | |
125 | (variantList ,[variant -> v] ...)) | |
126 | (x11-keymap-layout | |
127 | (name name) | |
d58e52b0 | 128 | (synopsis (maybe-empty |
818595a9 | 129 | (assoc-ref rest-layout 'shortDescription))) |
d58e52b0 | 130 | (description (maybe-empty |
d0f3a672 MO |
131 | (assoc-ref rest-layout 'description))) |
132 | (variants (list v ...)))] | |
133 | [(layout | |
134 | (configItem | |
135 | (name ,name) | |
136 | . ,rest-layout)) | |
137 | (x11-keymap-layout | |
138 | (name name) | |
d58e52b0 | 139 | (synopsis (maybe-empty |
818595a9 | 140 | (assoc-ref rest-layout 'shortDescription))) |
d58e52b0 | 141 | (description (maybe-empty |
d0f3a672 MO |
142 | (assoc-ref rest-layout 'description))) |
143 | (variants '()))])) | |
144 | ||
145 | (let ((sxml (call-with-input-file file | |
146 | (lambda (port) | |
147 | (xml->sxml port #:trim-whitespace? #t))))) | |
148 | (match | |
149 | (sxml-match sxml | |
150 | [(*TOP* | |
151 | ,pi | |
152 | (xkbConfigRegistry | |
153 | (@ . ,ignored) | |
154 | (modelList ,[model -> m] ...) | |
155 | (layoutList ,[layout -> l] ...) | |
156 | . ,rest)) | |
157 | (list | |
158 | (list m ...) | |
159 | (list l ...))]) | |
160 | ((models layouts) | |
161 | (values models layouts))))) | |
162 | ||
91c231a2 FP |
163 | (define (kmscon-update-keymap model layout variant options) |
164 | "Update kmscon keymap with the provided MODEL, LAYOUT, VARIANT and OPTIONS." | |
479414e1 MO |
165 | (and=> |
166 | (getenv "KEYMAP_UPDATE") | |
167 | (lambda (keymap-file) | |
168 | (unless (file-exists? keymap-file) | |
169 | (error "Unable to locate keymap update file")) | |
170 | ||
171 | ;; See file gnu/packages/patches/kmscon-runtime-keymap-switch.patch. | |
172 | ;; This dirty hack makes possible to update kmscon keymap at runtime by | |
173 | ;; writing an X11 keyboard model, layout and variant to a named pipe | |
174 | ;; referred by KEYMAP_UPDATE environment variable. | |
175 | (call-with-output-file keymap-file | |
176 | (lambda (port) | |
177 | (format port model) | |
178 | (put-u8 port 0) | |
179 | ||
180 | (format port layout) | |
181 | (put-u8 port 0) | |
182 | ||
91c231a2 FP |
183 | (format port (or variant "")) |
184 | (put-u8 port 0) | |
185 | ||
186 | (format port (or options "")) | |
479414e1 | 187 | (put-u8 port 0)))))) |