projects/guix·blob python-team · refs

187 lines · 6.8 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018, 2021 Mathieu Othacehe <[email protected]>
3;;; Copyright © 2020 Florian Pelz <[email protected]>
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
40 x11-keymap-layout-synopsis
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
51 default-keyboard-model
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
65 (synopsis x11-keymap-layout-synopsis) ;string (e.g., "en")
66 (description x11-keymap-layout-description) ;string (a whole phrase)
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
75;; Assume all modern keyboards have this model.
76(define default-keyboard-model (make-parameter "pc105"))
77
78(define (xkb-rules->models+layouts file)
79 "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL
80and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard
81Configuration Database, describing possible XKB configurations."
82 (define maybe-empty
83 (match-lambda
84 ((x) x)
85 (#f "")))
86
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)
116 (description (maybe-empty
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)
128 (synopsis (maybe-empty
129 (assoc-ref rest-layout 'shortDescription)))
130 (description (maybe-empty
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)
139 (synopsis (maybe-empty
140 (assoc-ref rest-layout 'shortDescription)))
141 (description (maybe-empty
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
163(define (kmscon-update-keymap model layout variant options)
164 "Update kmscon keymap with the provided MODEL, LAYOUT, VARIANT and OPTIONS."
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
183 (format port (or variant ""))
184 (put-u8 port 0)
185
186 (format port (or options ""))
187 (put-u8 port 0))))))