Newer
Older
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
()
(do* ((keycodes-per-modifier (card8-get 1))
(advance-by *replysize* keycodes-per-modifier)
(keys nil nil)
(i 0 (index+ i 1)))
((index= i 8))
(advance-buffer-offset advance-by)
(dotimes (j keycodes-per-modifier)
(let ((key (read-card8 j)))
(unless (zerop key)
(push key keys))))
(push (nreverse keys) lists)))
(values-list (nreverse lists))))
;; Either we will want lots of defconstants for well-known values, or perhaps
;; an integer-to-keyword translation function for well-known values.
(defun change-keyboard-mapping
(display keysyms &key (start 0) end (first-keycode start))
;; start/end give subrange of keysyms
;; first-keycode is the first-keycode to store at
(declare (type display display)
(type array-index start)
(type card8 first-keycode)
(type (or null array-index) end)
(type (array * (* *)) keysyms))
(let* ((keycode-end (or end (array-dimension keysyms 0)))
(keysyms-per-keycode (array-dimension keysyms 1))
(length (index- keycode-end start))
(size (index* length keysyms-per-keycode))
(request-length (index+ size 2)))
(declare (type array-index keycode-end keysyms-per-keycode length request-length))
(with-buffer-request (display *x-setkeyboardmapping*
:length (index-ash request-length 2)
:sizes (32))
(data length)
(length request-length)
(card8 first-keycode keysyms-per-keycode)
(progn
(do ((limit (index-ash (buffer-size display) -2))
(w (index+ 2 (index-ash buffer-boffset -2)))
(i start (index+ i 1)))
((index>= i keycode-end)
(setf (buffer-boffset display) (index-ash w 2)))
(declare (type array-index limit w i))
(when (index> w limit)
(buffer-flush display)
(setq w (index-ash (buffer-boffset display) -2)))
(do ((j 0 (index+ j 1)))
((index>= j keysyms-per-keycode))
(declare (type array-index j))
(card29-put (index* w 4) (aref keysyms i j))
(index-incf w)))))))
(defun keyboard-mapping (display &key first-keycode start end data)
;; First-keycode specifies which keycode to start at (defaults to min-keycode).
;; Start specifies where (in result) to put first-keycode. (defaults to first-keycode)
;; (- end start) is the number of keycodes to get. (End defaults to (1+ max-keycode)).
;; If DATA is specified, the results are put there.
(declare (type display display)
(type (or null card8) first-keycode)
(type (or null array-index) start end)
(type (or null (array * (* *))) data))
(declare (clx-values (array * (* *))))
(unless first-keycode (setq first-keycode (display-min-keycode display)))
(unless start (setq start first-keycode))
(unless end (setq end (1+ (display-max-keycode display))))
(with-buffer-request-and-reply (display *x-getkeyboardmapping* nil :sizes (8 32))
((card8 first-keycode (index- end start)))
(do* ((keysyms-per-keycode (card8-get 1))
(bytes-per-keycode (* keysyms-per-keycode 4))
(advance-by *replysize* bytes-per-keycode)
(keycode-count (floor (card32-get 4) keysyms-per-keycode)
(index- keycode-count 1))
(result (if (and (arrayp data)
(= (array-rank data) 2)
(>= (array-dimension data 0) (index+ start keycode-count))
(>= (array-dimension data 1) keysyms-per-keycode))
data
(make-array `(,(index+ start keycode-count) ,keysyms-per-keycode)
:element-type 'keysym :initial-element 0)))
(i start (1+ i)))
((zerop keycode-count) (setq data result))
(advance-buffer-offset advance-by)
(dotimes (j keysyms-per-keycode)
(setf (aref result i j) (card29-get (* j 4))))))
data)