[e90b2f]: src / clx / translate.lisp Maximize Restore History

Download this file

translate.lisp    563 lines (525 with data), 24.0 kB

  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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:YES -*-
;;;
;;; TEXAS INSTRUMENTS INCORPORATED
;;; P.O. BOX 2909
;;; AUSTIN, TEXAS 78769
;;;
;;; Copyright (C) 1987 Texas Instruments Incorporated.
;;;
;;; Permission is granted to any individual or institution to use, copy, modify,
;;; and distribute this software, provided that this complete copyright and
;;; permission notice is maintained, intact, in all copies and supporting
;;; documentation.
;;;
;;; Texas Instruments Incorporated provides this software "as is" without
;;; express or implied warranty.
;;;
(in-package :xlib)
(defvar *keysym-sets* nil) ;; Alist of (name first-keysym last-keysym)
(defun define-keysym-set (set first-keysym last-keysym)
;; Define all keysyms from first-keysym up to and including
;; last-keysym to be in SET (returned from the keysym-set function).
;; Signals an error if the keysym range overlaps an existing set.
(declare (type keyword set)
(type keysym first-keysym last-keysym))
(when (> first-keysym last-keysym)
(rotatef first-keysym last-keysym))
(setq *keysym-sets* (delete set *keysym-sets* :key #'car))
(dolist (set *keysym-sets*)
(let ((first (second set))
(last (third set)))
(when (or (<= first first-keysym last)
(<= first last-keysym last))
(error "Keysym range overlaps existing set ~s" set))))
(push (list set first-keysym last-keysym) *keysym-sets*)
set)
(defun keysym-set (keysym)
;; Return the character code set name of keysym
(declare (type keysym keysym)
(clx-values keyword))
(dolist (set *keysym-sets*)
(let ((first (second set))
(last (third set)))
(when (<= first keysym last)
(return (first set))))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro keysym (keysym &rest bytes)
;; Build a keysym.
;;
;; If KEYSYM is an integer, it is used as the most significant
;; bits of the keysym, and BYTES are used to specify low order
;; bytes. The last parameter is always byte4 of the keysym. If
;; KEYSYM is not an integer, the keysym associated with KEYSYM is
;; returned.
;;
;; This is a macro and not a function macro to promote
;; compile-time lookup. All arguments are evaluated.
;;
;; FIXME: The above means that this shouldn't really be a macro at
;; all, but a compiler macro. Probably, anyway.
(declare (type t keysym)
(type list bytes)
(clx-values keysym))
(typecase keysym
((integer 0 *)
(dolist (b bytes keysym) (setq keysym (+ (ash keysym 8) b))))
(otherwise
(or (car (character->keysyms keysym))
(error "~s Isn't the name of a keysym" keysym))))))
(defvar *keysym->character-map*
(make-hash-table :test (keysym->character-map-test) :size 400))
;; Keysym-mappings are a list of the form (object translate lowercase modifiers mask)
;; With the following accessor macros. Everything after OBJECT is optional.
(defmacro keysym-mapping-object (keysym-mapping)
;; Parameter to translate
`(first ,keysym-mapping))
(defmacro keysym-mapping-translate (keysym-mapping)
;; Function to be called with parameters (display state OBJECT)
;; when translating KEYSYM and modifiers and mask are satisfied.
`(second ,keysym-mapping))
(defmacro keysym-mapping-lowercase (keysym-mapping)
;; LOWERCASE is used for uppercase alphabetic keysyms. The value
;; is the associated lowercase keysym.
`(third ,keysym-mapping))
(defmacro keysym-mapping-modifiers (keysym-mapping)
;; MODIFIERS is either a modifier-mask or list containing intermixed
;; keysyms and state-mask-keys specifying when to use this
;; keysym-translation.
`(fourth ,keysym-mapping))
(defmacro keysym-mapping-mask (keysym-mapping)
;; MASK is either a modifier-mask or list containing intermixed
;; keysyms and state-mask-keys specifying which modifiers to look at
;; (i.e. modifiers not specified are don't-cares)
`(fifth ,keysym-mapping))
(defvar *default-keysym-translate-mask*
(the (or (member :modifiers) mask16 (clx-list (or keysym state-mask-key)))
(logand #xff (lognot (make-state-mask :lock))))
"Default keysym state mask to use during keysym-translation.")
(defun define-keysym (object keysym &key lowercase translate modifiers mask display)
;; Define the translation from keysym/modifiers to a (usually
;; character) object. ANy previous keysym definition with
;; KEYSYM and MODIFIERS is deleted before adding the new definition.
;;
;; MODIFIERS is either a modifier-mask or list containing intermixed
;; keysyms and state-mask-keys specifying when to use this
;; keysym-translation. The default is NIL.
;;
;; MASK is either a modifier-mask or list containing intermixed
;; keysyms and state-mask-keys specifying which modifiers to look at
;; (i.e. modifiers not specified are don't-cares).
;; If mask is :MODIFIERS then the mask is the same as the modifiers
;; (i.e. modifiers not specified by modifiers are don't cares)
;; The default mask is *default-keysym-translate-mask*
;;
;; If DISPLAY is specified, the translation will be local to DISPLAY,
;; otherwise it will be the default translation for all displays.
;;
;; LOWERCASE is used for uppercase alphabetic keysyms. The value
;; is the associated lowercase keysym. This information is used
;; by the keysym-both-case-p predicate (for caps-lock computations)
;; and by the keysym-downcase function.
;;
;; TRANSLATE will be called with parameters (display state OBJECT)
;; when translating KEYSYM and modifiers and mask are satisfied.
;; [e.g (zerop (logxor (logand state (or mask *default-keysym-translate-mask*))
;; (or modifiers 0)))
;; when mask and modifiers aren't lists of keysyms]
;; The default is #'default-keysym-translate
;;
(declare (type (or base-char t) object)
(type keysym keysym)
(type (or null mask16 (clx-list (or keysym state-mask-key)))
modifiers)
(type (or null (member :modifiers) mask16 (clx-list (or keysym state-mask-key)))
mask)
(type (or null display) display)
(type (or null keysym) lowercase)
(type (or null (function (display card16 t) t)) translate))
(flet ((merge-keysym-mappings (new old)
;; Merge new keysym-mapping with list of old mappings.
;; Ensure that the mapping with no modifiers or mask comes first.
(let* ((key (keysym-mapping-modifiers new))
(merge (delete key old :key #'cadddr :test #'equal)))
(if key
(nconc merge (list new))
(cons new merge))))
(mask-check (mask)
(unless (or (numberp mask)
(dolist (element mask t)
(unless (or (find element +state-mask-vector+)
(gethash element *keysym->character-map*))
(return nil))))
(x-type-error mask '(or mask16 (clx-list (or modifier-key modifier-keysym)))))))
(let ((entry
;; Create with a single LIST call, to ensure cdr-coding
(cond
(mask
(unless (eq mask :modifiers)
(mask-check mask))
(when (or (null modifiers) (and (numberp modifiers) (zerop modifiers)))
(error "Mask with no modifiers"))
(list object translate lowercase modifiers mask))
(modifiers (mask-check modifiers)
(list object translate lowercase modifiers))
(lowercase (list object translate lowercase))
(translate (list object translate))
(t (list object)))))
(if display
(let ((previous (assoc keysym (display-keysym-translation display))))
(if previous
(setf (cdr previous) (merge-keysym-mappings entry (cdr previous)))
(push (list keysym entry) (display-keysym-translation display))))
(setf (gethash keysym *keysym->character-map*)
(merge-keysym-mappings entry (gethash keysym *keysym->character-map*)))))
object))
(defun undefine-keysym (object keysym &key display modifiers &allow-other-keys)
;; Undefine the keysym-translation translating KEYSYM to OBJECT with MODIFIERS.
;; If DISPLAY is non-nil, undefine the translation for DISPLAY if it exists.
(declare (type (or base-char t) object)
(type keysym keysym)
(type (or null mask16 (clx-list (or keysym state-mask-key)))
modifiers)
(type (or null display) display))
(flet ((match (key entry)
(let ((object (car key))
(modifiers (cdr key)))
(or (eql object (keysym-mapping-object entry))
(equal modifiers (keysym-mapping-modifiers entry))))))
(let* (entry
(previous (if display
(cdr (setq entry (assoc keysym (display-keysym-translation display))))
(gethash keysym *keysym->character-map*)))
(key (cons object modifiers)))
(when (and previous (find key previous :test #'match))
(setq previous (delete key previous :test #'match))
(if display
(setf (cdr entry) previous)
(setf (gethash keysym *keysym->character-map*) previous))))))
(defun keysym-downcase (keysym)
;; If keysym has a lower-case equivalent, return it, otherwise return keysym.
(declare (type keysym keysym))
(declare (clx-values keysym))
(let ((translations (gethash keysym *keysym->character-map*)))
(or (and translations (keysym-mapping-lowercase (first translations))) keysym)))
(defun keysym-uppercase-alphabetic-p (keysym)
;; Returns T if keysym is uppercase-alphabetic.
;; I.E. If it has a lowercase equivalent.
(declare (type keysym keysym))
(declare (clx-values (or null keysym)))
(let ((translations (gethash keysym *keysym->character-map*)))
(and translations
(keysym-mapping-lowercase (first translations)))))
(defun character->keysyms (character &optional display)
;; Given a character, return a list of all matching keysyms.
;; If DISPLAY is given, translations specific to DISPLAY are used,
;; otherwise only global translations are used.
;; Implementation dependent function.
;; May be slow [i.e. do a linear search over all known keysyms]
(declare (type t character)
(type (or null display) display)
(clx-values (clx-list keysym)))
(let ((result nil))
(when display
(dolist (mapping (display-keysym-translation display))
(when (eql character (second mapping))
(push (first mapping) result))))
(maphash #'(lambda (keysym mappings)
(dolist (mapping mappings)
(when (eql (keysym-mapping-object mapping) character)
(pushnew keysym result))))
*keysym->character-map*)
result))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant character-set-switch-keysym (keysym 255 126))
(defconstant left-shift-keysym (keysym 255 225))
(defconstant right-shift-keysym (keysym 255 226))
(defconstant left-control-keysym (keysym 255 227))
(defconstant right-control-keysym (keysym 255 228))
(defconstant caps-lock-keysym (keysym 255 229))
(defconstant shift-lock-keysym (keysym 255 230))
(defconstant left-meta-keysym (keysym 255 231))
(defconstant right-meta-keysym (keysym 255 232))
(defconstant left-alt-keysym (keysym 255 233))
(defconstant right-alt-keysym (keysym 255 234))
(defconstant left-super-keysym (keysym 255 235))
(defconstant right-super-keysym (keysym 255 236))
(defconstant left-hyper-keysym (keysym 255 237))
(defconstant right-hyper-keysym (keysym 255 238)))
;;-----------------------------------------------------------------------------
;; Keysym mapping functions
(defun display-keyboard-mapping (display)
(declare (type display display))
(declare (clx-values (simple-array keysym (display-max-keycode keysyms-per-keycode))))
(or (display-keysym-mapping display)
(setf (display-keysym-mapping display) (keyboard-mapping display))))
(defun keycode->keysym (display keycode keysym-index)
(declare (type display display)
(type card8 keycode)
(type card8 keysym-index)
(clx-values keysym))
(let* ((mapping (display-keyboard-mapping display))
(keysym (aref mapping keycode keysym-index)))
(declare (type (simple-array keysym (* *)) mapping)
(type keysym keysym))
;; The keysym-mapping is brain dammaged.
;; Mappings for both-case alphabetic characters have the
;; entry for keysym-index zero set to the uppercase keysym
;; (this is normally where the lowercase keysym goes), and the
;; entry for keysym-index one is zero.
(cond ((zerop keysym-index) ; Lowercase alphabetic keysyms
(keysym-downcase keysym))
((and (zerop keysym) (plusp keysym-index)) ; Get the uppercase keysym
(aref mapping keycode 0))
(t keysym))))
(defun keysym->character (display keysym &optional (state 0))
;; Find the character associated with a keysym.
;; STATE can be used to set character attributes.
;; Implementation dependent function.
(declare (type display display)
(type keysym keysym)
(type card16 state))
(declare (clx-values (or null character)))
(let* ((display-mappings (cdr (assoc keysym (display-keysym-translation display))))
(mapping (or ;; Find the matching display mapping
(dolist (mapping display-mappings)
(when (mapping-matches-p display state mapping)
(return mapping)))
;; Find the matching static mapping
(dolist (mapping (gethash keysym *keysym->character-map*))
(when (mapping-matches-p display state mapping)
(return mapping))))))
(when mapping
(funcall (or (keysym-mapping-translate mapping) 'default-keysym-translate)
display state (keysym-mapping-object mapping)))))
(defun mapping-matches-p (display state mapping)
;; Returns T when the modifiers and mask in MAPPING satisfies STATE for DISPLAY
(declare (type display display)
(type mask16 state)
(type list mapping))
(declare (clx-values generalized-boolean))
(flet
((modifiers->mask (display-mapping modifiers errorp &aux (mask 0))
;; Convert MODIFIERS, which is a modifier mask, or a list of state-mask-keys into a mask.
;; If ERRORP is non-nil, return NIL when an unknown modifier is specified,
;; otherwise ignore unknown modifiers.
(declare (type list display-mapping) ; Alist of (keysym . mask)
(type (or mask16 list) modifiers)
(type mask16 mask))
(declare (clx-values (or null mask16)))
(if (numberp modifiers)
modifiers
(dolist (modifier modifiers mask)
(declare (type symbol modifier))
(let ((bit (position modifier (the simple-vector +state-mask-vector+) :test #'eq)))
(setq mask
(logior mask
(if bit
(ash 1 bit)
(or (cdr (assoc modifier display-mapping))
;; bad modifier
(if errorp
(return-from modifiers->mask nil)
0))))))))))
(let* ((display-mapping (get-display-modifier-mapping display))
(mapping-modifiers (keysym-mapping-modifiers mapping))
(modifiers (or (modifiers->mask display-mapping (or mapping-modifiers 0) t)
(return-from mapping-matches-p nil)))
(mapping-mask (or (keysym-mapping-mask mapping) ; If no mask, use the default.
(if mapping-modifiers ; If no modifiers, match anything.
*default-keysym-translate-mask*
0)))
(mask (if (eq mapping-mask :modifiers)
modifiers
(modifiers->mask display-mapping mapping-mask nil))))
(declare (type mask16 modifiers mask))
(= (logand state mask) modifiers))))
(defun default-keysym-index (display keycode state)
;; Returns a keysym-index for use with keycode->character
(declare (clx-values card8))
(macrolet ((keystate-p (state keyword)
`(logbitp ,(position keyword +state-mask-vector+) ,state)))
(let* ((mapping (display-keyboard-mapping display))
(keysyms-per-keycode (array-dimension mapping 1))
(symbolp (and (> keysyms-per-keycode 2)
(state-keysymp display state character-set-switch-keysym)))
(result (if symbolp 2 0)))
(declare (type (simple-array keysym (* *)) mapping)
(type generalized-boolean symbolp)
(type card8 keysyms-per-keycode result))
(when (and (< result keysyms-per-keycode)
(keysym-shift-p display state (keysym-uppercase-alphabetic-p
(aref mapping keycode 0))))
(incf result))
result)))
(defun keysym-shift-p (display state uppercase-alphabetic-p &key
shift-lock-xors
(control-modifiers
'#.(list left-meta-keysym left-super-keysym left-hyper-keysym)))
(declare (type display display)
(type card16 state)
(type generalized-boolean uppercase-alphabetic-p)
(type generalized-boolean shift-lock-xors));;; If T, both SHIFT-LOCK and SHIFT is the same
;;; as neither if the character is alphabetic.
(declare (clx-values generalized-boolean))
(macrolet ((keystate-p (state keyword)
`(logbitp ,(position keyword +state-mask-vector+) ,state)))
(let* ((controlp (or (keystate-p state :control)
(dolist (modifier control-modifiers)
(when (state-keysymp display state modifier)
(return t)))))
(shiftp (keystate-p state :shift))
(lockp (keystate-p state :lock))
(alphap (or uppercase-alphabetic-p
(not (state-keysymp display #.(make-state-mask :lock)
caps-lock-keysym)))))
(declare (type generalized-boolean controlp shiftp lockp alphap))
;; Control keys aren't affected by lock
(unless controlp
;; Not a control character - check state of lock modifier
(when (and lockp
alphap
(or (not shiftp) shift-lock-xors)) ; Lock doesn't unshift unless shift-lock-xors
(setq shiftp (not shiftp))))
shiftp)))
;;; default-keysym-index implements the following tables:
;;;
;;; control shift caps-lock character character
;;; 0 0 0 #\a #\8
;;; 0 0 1 #\A #\8
;;; 0 1 0 #\A #\*
;;; 0 1 1 #\A #\*
;;; 1 0 0 #\control-A #\control-8
;;; 1 0 1 #\control-A #\control-8
;;; 1 1 0 #\control-shift-a #\control-*
;;; 1 1 1 #\control-shift-a #\control-*
;;;
;;; control shift shift-lock character character
;;; 0 0 0 #\a #\8
;;; 0 0 1 #\A #\*
;;; 0 1 0 #\A #\*
;;; 0 1 1 #\A #\8
;;; 1 0 0 #\control-A #\control-8
;;; 1 0 1 #\control-A #\control-*
;;; 1 1 0 #\control-shift-a #\control-*
;;; 1 1 1 #\control-shift-a #\control-8
(defun keycode->character (display keycode state &key keysym-index
(keysym-index-function #'default-keysym-index))
;; keysym-index defaults to the result of keysym-index-function which
;; is called with the following parameters:
;; (char0 state caps-lock-p keysyms-per-keycode)
;; where char0 is the "character" object associated with keysym-index 0 and
;; caps-lock-p is non-nil when the keysym associated with the lock
;; modifier is for caps-lock.
;; STATE can also used for setting character attributes.
;; Implementation dependent function.
(declare (type display display)
(type card8 keycode)
(type card16 state)
(type (or null card8) keysym-index)
(type (or null (function (base-char card16 generalized-boolean card8) card8))
keysym-index-function))
(declare (clx-values (or null character)))
(let* ((index (or keysym-index
(funcall keysym-index-function display keycode state)))
(keysym (if index (keycode->keysym display keycode index) 0)))
(declare (type (or null card8) index)
(type keysym keysym))
(when (plusp keysym)
(keysym->character display keysym state))))
(defun get-display-modifier-mapping (display)
(labels ((keysym-replace (display modifiers mask &aux result)
(dolist (modifier modifiers result)
(push (cons (keycode->keysym display modifier 0) mask) result))))
(or (display-modifier-mapping display)
(multiple-value-bind (shift lock control mod1 mod2 mod3 mod4 mod5)
(modifier-mapping display)
(setf (display-modifier-mapping display)
(nconc (keysym-replace display shift #.(make-state-mask :shift))
(keysym-replace display lock #.(make-state-mask :lock))
(keysym-replace display control #.(make-state-mask :control))
(keysym-replace display mod1 #.(make-state-mask :mod-1))
(keysym-replace display mod2 #.(make-state-mask :mod-2))
(keysym-replace display mod3 #.(make-state-mask :mod-3))
(keysym-replace display mod4 #.(make-state-mask :mod-4))
(keysym-replace display mod5 #.(make-state-mask :mod-5))))))))
(defun state-keysymp (display state keysym)
;; Returns T when a modifier key associated with KEYSYM is on in STATE
(declare (type display display)
(type card16 state)
(type keysym keysym))
(declare (clx-values generalized-boolean))
(let* ((mapping (get-display-modifier-mapping display))
(mask (assoc keysym mapping)))
(and mask (plusp (logand state (cdr mask))))))
(defun mapping-notify (display request start count)
;; Called on a mapping-notify event to update
;; the keyboard-mapping cache in DISPLAY
(declare (type display display)
(type (member :modifier :keyboard :pointer) request)
(type card8 start count)
(ignore count start))
;; Invalidate the keyboard mapping to force the next key translation to get it
(case request
(:modifier
(setf (display-modifier-mapping display) nil))
(:keyboard
(setf (display-keysym-mapping display) nil))))
(defun keysym-in-map-p (display keysym keymap)
;; Returns T if keysym is found in keymap
(declare (type display display)
(type keysym keysym)
(type (bit-vector 256) keymap))
(declare (clx-values generalized-boolean))
;; The keysym may appear in the keymap more than once,
;; So we have to search the entire keysym map.
(do* ((min (display-min-keycode display))
(max (display-max-keycode display))
(map (display-keyboard-mapping display))
(jmax (min 2 (array-dimension map 1)))
(i min (1+ i)))
((> i max))
(declare (type card8 min max jmax)
(type (simple-array keysym (* *)) map))
(when (and (plusp (aref keymap i))
(dotimes (j jmax)
(when (= keysym (aref map i j)) (return t))))
(return t))))
(defun character-in-map-p (display character keymap)
;; Implementation dependent function.
;; Returns T if character is found in keymap
(declare (type display display)
(type character character)
(type (bit-vector 256) keymap))
(declare (clx-values generalized-boolean))
;; Check all one bits in keymap
(do* ((min (display-min-keycode display))
(max (display-max-keycode display))
(jmax (array-dimension (display-keyboard-mapping display) 1))
(i min (1+ i)))
((> i max))
(declare (type card8 min max jmax))
(when (and (plusp (aref keymap i))
;; Match when character is in mapping for this keycode
(dotimes (j jmax)
(when (eql character (keycode->character display i 0 :keysym-index j))
(return t))))
(return t))))
(defun keysym->keycodes (display keysym)
;; Return keycodes for keysym, as multiple values
(declare (type display display)
(type keysym keysym))
(declare (clx-values (or null keycode) (or null keycode) (or null keycode)))
;; The keysym may appear in the keymap more than once,
;; So we have to search the entire keysym map.
(do* ((min (display-min-keycode display))
(max (display-max-keycode display))
(map (display-keyboard-mapping display))
(jmax (min 2 (array-dimension map 1)))
(i min (1+ i))
(result nil))
((> i max) (values-list result))
(declare (type card8 min max jmax)
(type (simple-array keysym (* *)) map))
(dotimes (j jmax)
(when (= keysym (aref map i j))
(push i result)))))