Commit | Line | Data |
---|---|---|
d0f3a672 MO |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | |
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." | |
82 | (define (model m) | |
83 | (sxml-match m | |
84 | [(model | |
85 | (configItem | |
86 | (name ,name) | |
87 | (description ,description) | |
88 | . ,rest)) | |
89 | (x11-keymap-model | |
90 | (name name) | |
91 | (description description))])) | |
92 | ||
93 | (define (variant v) | |
94 | (sxml-match v | |
95 | [(variant | |
96 | ;; According to xbd-rules DTD, the definition of a | |
97 | ;; configItem is: <!ELEMENT configItem | |
98 | ;; (name,shortDescription*,description*,vendor?, | |
99 | ;; countryList?,languageList?,hwList?)> | |
100 | ;; | |
101 | ;; shortDescription and description are optional elements | |
102 | ;; but sxml-match does not support default values for | |
103 | ;; elements (only attributes). So to avoid writing as many | |
104 | ;; patterns as existing possibilities, gather all the | |
105 | ;; remaining elements but name in REST-VARIANT. | |
106 | (configItem | |
107 | (name ,name) | |
108 | . ,rest-variant)) | |
109 | (x11-keymap-variant | |
110 | (name name) | |
111 | (description (car | |
112 | (assoc-ref rest-variant 'description))))])) | |
113 | ||
114 | (define (layout l) | |
115 | (sxml-match l | |
116 | [(layout | |
117 | (configItem | |
118 | (name ,name) | |
119 | . ,rest-layout) | |
120 | (variantList ,[variant -> v] ...)) | |
121 | (x11-keymap-layout | |
122 | (name name) | |
818595a9 LC |
123 | (synopsis (car |
124 | (assoc-ref rest-layout 'shortDescription))) | |
d0f3a672 MO |
125 | (description (car |
126 | (assoc-ref rest-layout 'description))) | |
127 | (variants (list v ...)))] | |
128 | [(layout | |
129 | (configItem | |
130 | (name ,name) | |
131 | . ,rest-layout)) | |
132 | (x11-keymap-layout | |
133 | (name name) | |
818595a9 LC |
134 | (synopsis (car |
135 | (assoc-ref rest-layout 'shortDescription))) | |
d0f3a672 MO |
136 | (description (car |
137 | (assoc-ref rest-layout 'description))) | |
138 | (variants '()))])) | |
139 | ||
140 | (let ((sxml (call-with-input-file file | |
141 | (lambda (port) | |
142 | (xml->sxml port #:trim-whitespace? #t))))) | |
143 | (match | |
144 | (sxml-match sxml | |
145 | [(*TOP* | |
146 | ,pi | |
147 | (xkbConfigRegistry | |
148 | (@ . ,ignored) | |
149 | (modelList ,[model -> m] ...) | |
150 | (layoutList ,[layout -> l] ...) | |
151 | . ,rest)) | |
152 | (list | |
153 | (list m ...) | |
154 | (list l ...))]) | |
155 | ((models layouts) | |
156 | (values models layouts))))) | |
157 | ||
91c231a2 FP |
158 | (define (kmscon-update-keymap model layout variant options) |
159 | "Update kmscon keymap with the provided MODEL, LAYOUT, VARIANT and OPTIONS." | |
479414e1 MO |
160 | (and=> |
161 | (getenv "KEYMAP_UPDATE") | |
162 | (lambda (keymap-file) | |
163 | (unless (file-exists? keymap-file) | |
164 | (error "Unable to locate keymap update file")) | |
165 | ||
166 | ;; See file gnu/packages/patches/kmscon-runtime-keymap-switch.patch. | |
167 | ;; This dirty hack makes possible to update kmscon keymap at runtime by | |
168 | ;; writing an X11 keyboard model, layout and variant to a named pipe | |
169 | ;; referred by KEYMAP_UPDATE environment variable. | |
170 | (call-with-output-file keymap-file | |
171 | (lambda (port) | |
172 | (format port model) | |
173 | (put-u8 port 0) | |
174 | ||
175 | (format port layout) | |
176 | (put-u8 port 0) | |
177 | ||
91c231a2 FP |
178 | (format port (or variant "")) |
179 | (put-u8 port 0) | |
180 | ||
181 | (format port (or options "")) | |
479414e1 | 182 | (put-u8 port 0)))))) |