branch: externals/xelb
commit f5216dc13ff44a9f86bdff18272d9b8db1ee7cc5
Merge: e58ac74 600b825
Author: Chris Feng <chris.w.f...@gmail.com>
Commit: Chris Feng <chris.w.f...@gmail.com>
Merge branch 'feat/xkb' into externals/xelb
---
.elpaignore | 5 -
el_client.el | 77 +++++-
xcb-dri2.el | 4 +-
xcb-keysyms.el | 655 ++++++++++++++++++++++++++++++++++------------------
xcb-randr.el | 3 +-
xcb-render.el | 52 ++---
xcb-screensaver.el | 30 +--
xcb-sync.el | 24 +-
xcb-types.el | 63 ++---
xcb-xf86vidmode.el | 28 +--
xcb-xinput.el | 147 ++++--------
xcb-xkb.el | 194 ++++++++--------
xcb-xproto.el | 185 +++++++--------
xcb.el | 3 +
14 files changed, 849 insertions(+), 621 deletions(-)
diff --git a/.elpaignore b/.elpaignore
index 319bcbf..b43bf86 100644
--- a/.elpaignore
+++ b/.elpaignore
@@ -1,6 +1 @@
-Makefile
README.md
-el_client.el
-
-# Exclude xcb-xkb.el for now, as it does not work on Emacs 24
-xcb-xkb.el
diff --git a/el_client.el b/el_client.el
index 02d78ad..cdeb82d 100644
--- a/el_client.el
+++ b/el_client.el
@@ -41,10 +41,17 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'eieio)
(require 'pp)
+;; Only used to eliminate compile warnings when distributed.
+(require 'xcb-types nil t)
+
;;;; Variables
+(defconst xelb-excluded-replies<25 '(xcb:xkb:GetKbdByName~reply)
+ "Excluded replies for Emacs < 25 (they're too long to load/compile).")
+
(defvar xelb-prefix "xcb:" "Namespace of this module.")
(make-variable-buffer-local 'xelb-prefix)
@@ -141,6 +148,36 @@ an `xelb-auto-padding' attribute."
(eq (xelb-node-name i) 'doc)))
(throw 'break i))))))
+(defun xelb-node-size (node)
+ "Return the size of NODE in bytes."
+ (pcase (xelb-node-name node)
+ (`pad (xelb-node-attr node 'bytes))
+ (`field (xelb-type-size (xelb-node-type node)))
+ (`list (* (xelb-type-size (xelb-node-type node))
+ (xelb-parse-expression (xelb-node-subnode node))))
+ ((or `comment `doc) 0)
+ (x (error "Unexpected element: <%s>" x))))
+
+(defun xelb-type-size (type &optional slot)
+ "Return size of TYPE in bytes."
+ (pcase (indirect-variable type)
+ (`xcb:-ignore 0)
+ ((or `xcb:-u1 `xcb:-i1 `xcb:void) 1)
+ ((or `xcb:-u2 `xcb:-i2) 2)
+ ((or `xcb:-u4 `xcb:-i4) 4)
+ (`xcb:-u8 8)
+ (`xcb:-pad (cl--slot-descriptor-initform slot))
+ (`xcb:-list
+ (let ((initform (cadr (cl--slot-descriptor-initform slot))))
+ (* (plist-get initform 'size)
+ (xelb-type-size (plist-get initform 'type)))))
+ ((and x (guard (child-of-class-p x 'xcb:-struct)))
+ (apply #'+
+ (mapcar (lambda (slot)
+ (xelb-type-size (cl--slot-descriptor-type slot) slot))
+ (eieio-class-slots x))))
+ (x (error "Unknown size of type: %s" x))))
+
(defsubst xelb-generate-pad-name ()
"Generate a new slot name for <pad>."
(make-symbol (format "pad~%d" (cl-incf xelb-pad-count))))
@@ -153,7 +190,10 @@ an `xelb-auto-padding' attribute."
result header)
(with-temp-buffer
(insert-file-contents file)
- (setq result (libxml-parse-xml-region (point-min) (point-max) nil t))
+ (setq result (libxml-parse-xml-region (point-min) (point-max)))
+ (unless (eq 'xcb (xelb-node-name result))
+ ;; There's an extra comment.
+ (setq result (xelb-node-subnode result)))
(cl-assert (eq 'xcb (xelb-node-name result)))
(setq header (xelb-node-attr result 'header))
(unless (string= header "xproto")
@@ -220,6 +260,7 @@ an `xelb-auto-padding' attribute."
(let ((result (xelb-parse-top-level-element i)))
(when result ;skip <doc>, comments, etc
(dolist (j result)
+ (eval j) ;Make it immediately available.
(pp j))
(princ "\n"))))
;; Print error/event alists
@@ -283,7 +324,10 @@ an `xelb-auto-padding' attribute."
(let ((name (intern (concat xelb-prefix (xelb-node-attr node 'name))))
(contents (xelb-node-subnodes node)))
`((defclass ,name (xcb:-union)
- ,(apply #'nconc (mapcar #'xelb-parse-structure-content contents))))))
+ ,(apply #'nconc
+ `((~size :initform
+ ,(apply #'max (mapcar #'xelb-node-size contents))))
+ (mapcar #'xelb-parse-structure-content contents))))))
(defun xelb-parse-xidtype (node)
"Parse <xidtype>."
@@ -362,10 +406,21 @@ The `combine-adjacent' attribute is simply ignored."
`(cl-defmethod xcb:marshal ((obj ,name)) nil
,@expressions
(cl-call-next-method obj)))
+ ,(when (memq reply-name xelb-excluded-replies<25)
+ ;; Redefine `defclass' as no-op.
+ '(eval-and-compile
+ (when (< emacs-major-version 25)
+ (fset 'xcb:-defclass (symbol-function 'defclass))
+ (defmacro defclass (&rest _args)))))
;; The optional reply body
,(when reply-name
(delq nil reply-contents)
- `(defclass ,reply-name (xcb:-reply) ,reply-contents))))))
+ `(defclass ,reply-name (xcb:-reply) ,reply-contents))
+ ,(when (memq reply-name xelb-excluded-replies<25)
+ ;; Bring back the original defination of `defclass'.
+ '(eval-and-compile
+ (when (< emacs-major-version 25)
+ (fset 'defclass (symbol-function 'xcb:-defclass)))))))))
(defun xelb-parse-event (node)
"Parse <event>.
@@ -526,10 +581,16 @@ KeymapNotify event; instead, we handle this case in
`xcb:unmarshal'."
(setq fields (nconc fields tmp))
(setq name-list
(nconc name-list (list (caar tmp)))))))
- (when (eq case-name 'bitcase)
+ (if (eq case-name 'case)
+ (when (= 1 (length condition))
+ ;; Flatten 1-element list.
+ (setq condition (car condition)))
(setq condition (if (= 1 (length condition))
+ ;; Flatten 1-element list.
(car condition)
- `(logior ,@condition)))))
+ (if (cl-every #'integerp condition)
+ (apply #'logior condition)
+ `(logior ,@condition))))))
`(,condition ,@name-list)))
cases))
`((,name :initform '(expression ,expression cases ,cases)
@@ -598,13 +659,13 @@ KeymapNotify event; instead, we handle this case in
`xcb:unmarshal'."
"Parse <enumref>."
(let ((name (concat (xelb-node-attr node 'ref) ":"
(xelb-node-subnode node))))
- (or (intern-soft (concat "xcb:" name))
- (intern (concat xelb-prefix name)))))
+ (symbol-value (or (intern-soft (concat "xcb:" name))
+ (intern (concat xelb-prefix name))))))
(defun xelb-parse-unop (node)
"Parse <unop>."
(cl-assert (string= "~" (xelb-node-attr node 'op)))
- `(lognot (xelb-parse-expression (xelb-node-subnode node))))
+ `(lognot ,(xelb-parse-expression (xelb-node-subnode node))))
(defun xelb-parse-sumof (node)
"Parse <sumof>."
diff --git a/xcb-dri2.el b/xcb-dri2.el
index 8e52916..b967349 100644
--- a/xcb-dri2.el
+++ b/xcb-dri2.el
@@ -101,9 +101,7 @@
(+
(xcb:-fieldref 'driver-name-length)
3)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node))))
+ (lognot 3))
(xcb:-fieldref 'driver-name-length)))
:type xcb:-list)
(pad~3 :initform 4 :type xcb:-pad-align)
diff --git a/xcb-keysyms.el b/xcb-keysyms.el
index dd7b797..5db181d 100644
--- a/xcb-keysyms.el
+++ b/xcb-keysyms.el
@@ -32,10 +32,6 @@
;; thus shall be used in preference to 'xcb:ModMask:*' or
;; 'xcb:KeyButMask:Mod*'.
-;; Todo:
-;; + Is xcb:ModMask:Control/xcb:ModMask:Shift always equivalent to
-;; control/shift in Emacs?
-
;; References:
;; + X protocol (http://www.x.org/releases/X11R7.7/doc/xproto/x11protocol.txt)
;; + xcb/util-keysyms (git://anongit.freedesktop.org/xcb/util-keysyms)
@@ -43,187 +39,386 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-(require 'xcb)
-(defvar xcb:keysyms:auto-update t "Auto update keyboard mapping.")
-
-(defvar xcb:keysyms:meta-mask nil "META key mask.")
-(defvar xcb:keysyms:control-mask xcb:ModMask:Control "CONTROL key mask.")
-(defvar xcb:keysyms:shift-mask xcb:ModMask:Shift "SHIFT key mask.")
-(defvar xcb:keysyms:hyper-mask nil "HYPER key mask.")
-(defvar xcb:keysyms:super-mask nil "SUPER key mask.")
-(defvar xcb:keysyms:alt-mask nil "ALT key mask.")
-(defvar xcb:keysyms:lock-mask xcb:ModMask:Lock "LOCK key mask.")
-(defvar xcb:keysyms:num-lock-mask nil "NUM LOCK key mask.")
-(defvar xcb:keysyms:mode-switch-mask nil "MODE SWITCH key mask.")
+(require 'xcb)
+(require 'xcb-xkb)
+
+;; These variables are shared by all connections.
+(defvar xcb:keysyms:meta-mask 0 "META key mask.")
+(defvar xcb:keysyms:control-mask 0 "CONTROL key mask.")
+(defvar xcb:keysyms:shift-mask 0 "SHIFT key mask.")
+(defvar xcb:keysyms:hyper-mask 0 "HYPER key mask.")
+(defvar xcb:keysyms:super-mask 0 "SUPER key mask.")
+(defvar xcb:keysyms:alt-mask 0 "ALT key mask.")
+(defvar xcb:keysyms:lock-mask 0 "LOCK key mask.")
+;; Internal state / local data.
+(defvar xcb:keysyms:-opcode nil)
+(defvar xcb:keysyms:-device nil)
+(defvar xcb:keysyms:-keytypes nil)
+(defvar xcb:keysyms:-keycodes nil)
+(defvar xcb:keysyms:-modkeys nil)
+(defvar xcb:keysyms:-min-keycode nil)
+(defvar xcb:keysyms:-max-keycode nil)
(cl-defmethod xcb:keysyms:init ((obj xcb:connection))
"Initialize keysyms module.
This method must be called before using any other method in this module."
- (with-slots (min-keycode max-keycode) (xcb:get-setup obj)
- (xcb:keysyms:update-keyboard-mapping obj
- min-keycode
- (1+ (- max-keycode min-keycode)))
- (unless xcb:keysyms:meta-mask ;avoid duplicated initialization
- (xcb:keysyms:update-modifier-mapping obj)
- ;; Update on MappingNotify event.
- (when xcb:keysyms:auto-update
- (xcb:+event obj 'xcb:MappingNotify
- `(lambda (data _)
- (let ((obj1 (make-instance 'xcb:MappingNotify)))
- (xcb:unmarshal obj1 data)
- (with-slots (request first-keycode count) obj1
- (cond
- ((= request xcb:Mapping:Modifier)
- ;; Modifier keys changed
- (xcb:keysyms:update-modifier-mapping ,obj))
- ((= request xcb:Mapping:Keyboard)
- ;; Update changed keys
- (xcb:keysyms:update-keyboard-mapping
- ,obj first-keycode count)))))))))))
-
-(cl-defmethod xcb:keysyms:update-keyboard-mapping ((obj xcb:connection)
- first-keycode count)
- "Update keyboard mapping (from FIRST-KEYCODE to FIRST-KEYCODE + COUNT - 1)."
- (let* ((reply (xcb:+request-unchecked+reply obj
- (make-instance 'xcb:GetKeyboardMapping
- :first-keycode first-keycode :count count)))
- (keysyms-per-keycode (slot-value reply 'keysyms-per-keycode))
- (keysyms (slot-value reply 'keysyms))
- (result (plist-get (slot-value obj 'extra-plist) 'keysyms))
- keycode index row-index keysym)
- (dotimes (i count)
- (setq keycode (+ i first-keycode)
- index (* i keysyms-per-keycode)
- row-index 0)
- (setq keysym (nth (+ index row-index) keysyms))
- (setq result (assq-delete-all keycode result))
- (while (and (/= keysym 0) (< row-index keysyms-per-keycode))
- (setq result (append result `((,keycode . ,keysym)))
- row-index (1+ row-index)
- keysym (nth (+ index row-index) keysyms))))
- (setf (slot-value obj 'extra-plist)
- (plist-put (slot-value obj 'extra-plist) 'keysyms result))))
-
-;; Reference: 'x_find_modifier_meanings' in 'xterm.c'.
-(cl-defmethod xcb:keysyms:update-modifier-mapping ((obj xcb:connection))
- "Differentiate xcb:ModMask:1 ~ xcb:ModMask:5."
- (let* ((reply (xcb:+request-unchecked+reply obj
- (make-instance 'xcb:GetModifierMapping)))
- (keycodes-per-modifier (slot-value reply 'keycodes-per-modifier))
- (keycodes (slot-value reply 'keycodes))
- (mod-masks (vector xcb:ModMask:1 xcb:ModMask:2 xcb:ModMask:3
- xcb:ModMask:4 xcb:ModMask:5))
- keycode keysym found-alt-or-meta)
- (setq xcb:keysyms:meta-mask nil
- xcb:keysyms:hyper-mask nil
- xcb:keysyms:super-mask nil
- xcb:keysyms:alt-mask nil
- xcb:keysyms:num-lock-mask nil
- xcb:keysyms:mode-switch-mask nil)
- (cl-assert (= (length keycodes) (* 8 keycodes-per-modifier)))
- ;; Scan Mod1 ~ Mod5
- (setq keycodes (nthcdr (* 3 keycodes-per-modifier) keycodes))
- (dotimes (i 5)
- (setq found-alt-or-meta nil)
- (catch 'break
- (dotimes (j keycodes-per-modifier)
- (when (and (/= (setq keycode (pop keycodes)) 0)
- (setq keysym (xcb:keysyms:keycode->keysym obj keycode 0)))
- (pcase (xcb:keysyms:keysym->event obj keysym nil t)
- ((or `lmeta* `rmeta*)
- (setq found-alt-or-meta t
- xcb:keysyms:meta-mask (logior (or xcb:keysyms:meta-mask 0)
- (aref mod-masks i))))
- ((or `lhyper* `rhyper*)
- (unless found-alt-or-meta
- (setq xcb:keysyms:hyper-mask
- (logior (or xcb:keysyms:hyper-mask 0)
- (aref mod-masks i))))
- (setq keycodes (nthcdr (- keycodes-per-modifier j 1) keycodes))
- (throw 'break nil))
- ((or `lsuper* `rsuper*)
- (unless found-alt-or-meta
- (setq xcb:keysyms:super-mask
- (logior (or xcb:keysyms:super-mask 0)
- (aref mod-masks i))))
- (setq keycodes (nthcdr (- keycodes-per-modifier j 1) keycodes))
- (throw 'break nil))
- ((or `lalt* `ralt*)
- (setq found-alt-or-meta t
- xcb:keysyms:alt-mask (logior (or xcb:keysyms:alt-mask 0)
- (aref mod-masks i))))
- (`kp-numlock
- (setq xcb:keysyms:num-lock-mask (aref mod-masks i)))
- (`mode-switch*
- (setq xcb:keysyms:mode-switch-mask (aref mod-masks i)))
- (`shift-lock*
- (setq keycodes (nthcdr (- keycodes-per-modifier j) keycodes))
- (throw 'break nil)))))))
- ;; Meta fallbacks to Alt
- (unless xcb:keysyms:meta-mask
- (setq xcb:keysyms:meta-mask xcb:keysyms:alt-mask
- xcb:keysyms:alt-mask nil))
- ;; A key cannot be both Meta and Alt
- (when (and xcb:keysyms:meta-mask xcb:keysyms:alt-mask
- (logand xcb:keysyms:meta-mask xcb:keysyms:alt-mask))
- (setq xcb:keysyms:alt-mask (logand xcb:keysyms:alt-mask
- (lognot xcb:keysyms:meta-mask))))))
-
-(cl-defmethod xcb:keysyms:keycode->keysym ((obj xcb:connection)
- keycode modifiers)
- "Get the keysym from KeyPress event
-
-SHIFT LOCK is ignored."
- (let* ((keysyms (plist-get (slot-value obj 'extra-plist) 'keysyms))
- (group (delq nil (mapcar (lambda (i)
- (when (= keycode (car i)) (cdr i)))
- keysyms)))
- (mode-switch-on (and xcb:keysyms:mode-switch-mask ;not initialized
- (/= 0 (logand modifiers
- xcb:keysyms:mode-switch-mask))))
- (mask (logior (if (= 0 (logand modifiers xcb:keysyms:shift-mask)) 0 1)
- (if (= 0 (logand modifiers xcb:keysyms:lock-mask))
- 0 2))))
- (pcase (length group)
- (1 (setq group (vector (elt group 0) nil)))
- (2 (setq group (vector (elt group 0) (elt group 1))))
- (3 (setq group (if mode-switch-on
- (vector (elt group 2) nil)
- (vector (elt group 0) (elt group 1)))))
- (_ (setq group (if mode-switch-on
- (vector (elt group 2) (elt group 3))
- (vector (elt group 0) (elt group 1))))))
- (unless (aref group 0)
- (setq group (vector 0 (aref group 1))))
- (unless (aref group 1)
- (setq group (aref group 0)
- group (if (<= #x20 group #xff)
- ;; Only do case conversions for Latin-1 characters
- (vector (downcase group) (upcase group))
- (vector group group))))
- (if (and xcb:keysyms:num-lock-mask ;not initialized
- (/= 0 (logand modifiers xcb:keysyms:num-lock-mask))
- (<= #xff80 (aref group 1) #xffbe)) ;keypad
- (if (= mask 1) (aref group 0) (aref group 1))
- (pcase mask
- (0 (aref group 0)) ;SHIFT off, CAPS LOCK off
- (1 (aref group 1)) ;SHIFT on, CAPS LOCK off
- (2 ;SHIFT off, CAPS LOCK on
- (if (<= #x20 (aref group 0) #xff)
- (upcase (aref group 0)) (aref group 0)))
- (3 ;SHIFT on, CAPS LOCK on
- (if (<= #x20 (aref group 1) #xff)
- (upcase (aref group 1)) (aref group 1)))))))
-
-(cl-defmethod xcb:keysyms:keysym->keycode ((obj xcb:connection) keysym)
- "Convert X keysym to (first match) keycode"
- (car (rassoc keysym (plist-get (slot-value obj 'extra-plist) 'keysyms))))
+ (cond
+ ;; Avoid duplicated initializations.
+ (xcb:keysyms:-opcode)
+ ((= 0 (slot-value (xcb:get-extension-data obj 'xcb:xkb)
+ 'present))
+ (error "[XCB] XKB extension is not supported by the server"))
+ ((not (slot-value (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:xkb:UseExtension
+ :wantedMajor 1
+ :wantedMinor 0))
+ 'supported))
+ (error "[XCB] XKB extension version 1.0 is not supported by the server"))
+ (t
+ ;; Save the major opcode of XKB.
+ (setq xcb:keysyms:-opcode
+ (slot-value (xcb:get-extension-data obj 'xcb:xkb) 'major-opcode))
+ ;; Set per-client flags.
+ (xcb:keysyms:-set-per-client-flags obj xcb:xkb:ID:UseCoreKbd)
+ ;; Update data.
+ (xcb:keysyms:-update-keytypes obj xcb:xkb:ID:UseCoreKbd)
+ (xcb:keysyms:-update-keycodes obj xcb:xkb:ID:UseCoreKbd)
+ (xcb:keysyms:-update-modkeys obj xcb:xkb:ID:UseCoreKbd)
+ ;; Attach event listeners.
+ (xcb:+event obj 'xcb:xkb:NewKeyboardNotify
+ `(lambda (data _)
+ (xcb:keysyms:-on-NewKeyboardNotify ,obj data)))
+ (xcb:+event obj 'xcb:xkb:MapNotify
+ `(lambda (data _)
+ (xcb:keysyms:-on-MapNotify ,obj data)))
+ ;; Select XKB MapNotify and NewKeyboardNotify events.
+ (let ((map (logior xcb:xkb:MapPart:KeyTypes
+ xcb:xkb:MapPart:KeySyms
+ xcb:xkb:MapPart:ModifierMap))
+ (new-keyboard (logior xcb:xkb:NKNDetail:DeviceID
+ xcb:xkb:NKNDetail:Keycodes)))
+ (xcb:+request obj
+ (make-instance 'xcb:xkb:SelectEvents
+ :deviceSpec xcb:xkb:ID:UseCoreKbd
+ :affectWhich (logior
+ xcb:xkb:EventType:NewKeyboardNotify
+ xcb:xkb:EventType:MapNotify)
+ :clear 0
+ :selectAll 0
+ :affectMap map
+ :map map
+ :affectNewKeyboard new-keyboard
+ :newKeyboardDetails new-keyboard)))
+ (xcb:flush obj))))
+
+(cl-defmethod xcb:keysyms:-set-per-client-flags ((obj xcb:connection) device)
+ "Set per-client flags."
+ (let ((per-client-flags (logior
+ ;; Instead of compatibility state.
+ xcb:xkb:PerClientFlag:GrabsUseXKBState
+ ;; Instead of grab state.
+ xcb:xkb:PerClientFlag:LookupStateWhenGrabbed
+ ;; Use XKB state in 'SendEvent'.
+ xcb:xkb:PerClientFlag:SendEventUsesXKBState)))
+ ;; The reply is not used.
+ (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:xkb:PerClientFlags
+ :deviceSpec device
+ :change per-client-flags
+ :value per-client-flags
+ :ctrlsToChange 0
+ :autoCtrls 0
+ :autoCtrlsValues 0))))
+
+(cl-defmethod xcb:keysyms:-on-NewKeyboardNotify ((obj xcb:connection) data)
+ "Handle 'NewKeyboardNotify' event."
+ (let ((obj1 (make-instance 'xcb:xkb:NewKeyboardNotify)))
+ (xcb:unmarshal obj1 data)
+ (with-slots (deviceID requestMajor requestMinor changed) obj1
+ (if (= 0 (logand changed xcb:xkb:NKNDetail:DeviceID))
+ ;; Device is not changed; ensure it's a keycode change from
+ ;; this device.
+ (when (and (/= 0 (logand changed xcb:xkb:NKNDetail:Keycodes))
+ (= deviceID xcb:keysyms:-device)
+ ;; Also, according to the specification this can
+ ;; only happen when a GetKbdByName request issued.
+ ;; The two checks below avoid false positive caused
+ ;; by requests such as SetMap (e.g. XCape).
+ (= requestMajor xcb:keysyms:-opcode)
+ (= requestMinor
+ (eieio-oref-default 'xcb:xkb:GetKbdByName '~opcode)))
+ ;; (xcb:keysyms:-update-keytypes obj deviceID)
+ (xcb:keysyms:-update-keycodes obj deviceID)
+ (xcb:keysyms:-update-modkeys obj deviceID))
+ ;; Device changed; update the per-client flags and local data.
+ (xcb:keysyms:-set-per-client-flags obj deviceID)
+ (xcb:keysyms:-update-keytypes obj deviceID)
+ (xcb:keysyms:-update-keycodes obj deviceID)
+ (xcb:keysyms:-update-modkeys obj deviceID)))))
+
+(cl-defmethod xcb:keysyms:-on-MapNotify ((obj xcb:connection) data)
+ "Handle 'MapNotify' event."
+ (let ((obj1 (make-instance 'xcb:xkb:MapNotify)))
+ (xcb:unmarshal obj1 data)
+ (with-slots (deviceID changed firstType nTypes firstKeySym nKeySyms) obj1
+ ;; Ensure this event is for the current device.
+ (when (= deviceID xcb:keysyms:-device)
+ (when (/= 0 (logand changed xcb:xkb:MapPart:KeyTypes))
+ (xcb:keysyms:-update-keytypes obj deviceID firstType nTypes))
+ (when (/= 0 (logand changed xcb:xkb:MapPart:KeySyms))
+ (xcb:keysyms:-update-keycodes obj deviceID firstKeySym nKeySyms))
+ (when (/= 0 (logand changed xcb:xkb:MapPart:ModifierMap))
+ (xcb:keysyms:-update-modkeys obj deviceID))))))
+
+(cl-defmethod xcb:keysyms:-update-keytypes ((obj xcb:connection) device
+ &optional first-keytype count)
+ "Update key types.
+
+FIRST-KEYTYPE and count specify the range of key types to update."
+ (let (full partial)
+ (if (and first-keytype count)
+ (setq full 0
+ partial xcb:xkb:MapPart:KeyTypes)
+ (setq full xcb:xkb:MapPart:KeyTypes
+ partial 0
+ first-keytype 0
+ count 0))
+ (with-slots (deviceID present firstType nTypes totalTypes types-rtrn)
+ (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:xkb:GetMap
+ :deviceSpec device
+ :full full
+ :partial partial
+ :firstType first-keytype
+ :nTypes count
+ :firstKeySym 0
+ :nKeySyms 0
+ :firstKeyAction 0
+ :nKeyActions 0
+ :firstKeyBehavior 0
+ :nKeyBehaviors 0
+ :virtualMods 0
+ :firstKeyExplicit 0
+ :nKeyExplicit 0
+ :firstModMapKey 0
+ :nModMapKeys 0
+ :firstVModMapKey 0
+ :nVModMapKeys 0))
+ (cl-assert (/= 0 (logand present xcb:xkb:MapPart:KeyTypes)))
+ (when (/= 0 full)
+ (setq xcb:keysyms:-device deviceID
+ xcb:keysyms:-keytypes (make-vector totalTypes nil)))
+ (setq xcb:keysyms:-keytypes
+ (vconcat (substring xcb:keysyms:-keytypes 0 firstType)
+ types-rtrn
+ (substring xcb:keysyms:-keytypes (min (+ firstType nTypes)
+ totalTypes)))))))
+
+(cl-defmethod xcb:keysyms:-update-keycodes ((obj xcb:connection) device
+ &optional first-keycode count)
+ "Update keycode-keysym mapping.
+
+FIRST-KEYCODE and COUNT specify the keycode range to update."
+ (let (full partial)
+ (if (and first-keycode count)
+ (setq full 0
+ partial xcb:xkb:MapPart:KeySyms)
+ (setq full xcb:xkb:MapPart:KeySyms
+ partial 0
+ first-keycode 0
+ count 0))
+ (with-slots (deviceID minKeyCode maxKeyCode present
+ firstKeySym nKeySyms syms-rtrn)
+ (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:xkb:GetMap
+ :deviceSpec device
+ :full full
+ :partial partial
+ :firstType 0
+ :nTypes 0
+ :firstKeySym first-keycode
+ :nKeySyms count
+ :firstKeyAction 0
+ :nKeyActions 0
+ :firstKeyBehavior 0
+ :nKeyBehaviors 0
+ :virtualMods 0
+ :firstKeyExplicit 0
+ :nKeyExplicit 0
+ :firstModMapKey 0
+ :nModMapKeys 0
+ :firstVModMapKey 0
+ :nVModMapKeys 0))
+ (cl-assert (/= 0 (logand present xcb:xkb:MapPart:KeySyms)))
+ (when (or (/= 0 full)
+ ;; Unlikely?
+ (/= xcb:keysyms:-min-keycode minKeyCode)
+ (/= xcb:keysyms:-max-keycode maxKeyCode))
+ (setq xcb:keysyms:-min-keycode minKeyCode
+ xcb:keysyms:-max-keycode maxKeyCode
+ xcb:keysyms:-keycodes (make-vector (- xcb:keysyms:-max-keycode
+ xcb:keysyms:-min-keycode
+ -1)
+ nil)))
+ (setq xcb:keysyms:-keycodes
+ (vconcat
+ (substring xcb:keysyms:-keycodes 0 (- firstKeySym
+ xcb:keysyms:-min-keycode))
+ syms-rtrn
+ (substring xcb:keysyms:-keycodes
+ (- (min (+ firstKeySym nKeySyms)
+ xcb:keysyms:-max-keycode)
+ xcb:keysyms:-min-keycode)))))))
+
+(cl-defmethod xcb:keysyms:-update-modkeys ((obj xcb:connection) device)
+ "Update modifier keys."
+ (with-slots (deviceID present modmap-rtrn)
+ (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:xkb:GetMap
+ :deviceSpec device
+ :full xcb:xkb:MapPart:ModifierMap
+ :partial 0
+ :firstType 0
+ :nTypes 0
+ :firstKeySym 0
+ :nKeySyms 0
+ :firstKeyAction 0
+ :nKeyActions 0
+ :firstKeyBehavior 0
+ :nKeyBehaviors 0
+ :virtualMods 0
+ :firstKeyExplicit 0
+ :nKeyExplicit 0
+ :firstModMapKey 0
+ :nModMapKeys 0
+ :firstVModMapKey 0
+ :nVModMapKeys 0))
+ (cl-assert (/= 0 (logand present xcb:xkb:MapPart:ModifierMap)))
+ (setq xcb:keysyms:-modkeys modmap-rtrn))
+ (setq xcb:keysyms:meta-mask 0
+ xcb:keysyms:control-mask xcb:ModMask:Control
+ xcb:keysyms:shift-mask xcb:ModMask:Shift
+ xcb:keysyms:hyper-mask 0
+ xcb:keysyms:super-mask 0
+ xcb:keysyms:alt-mask 0
+ xcb:keysyms:lock-mask xcb:ModMask:Lock)
+ ;; Reference: 'x_find_modifier_meanings' in 'xterm.c'.
+ (dolist (modkey xcb:keysyms:-modkeys)
+ (with-slots (keycode mods) modkey
+ (let ((keysym (xcb:keysyms:keycode->keysym obj keycode 0)))
+ (when (/= 0 (car keysym))
+ (pcase (xcb:keysyms:keysym->event obj (car keysym) nil t)
+ ((or `lmeta* `rmeta*)
+ (setq xcb:keysyms:meta-mask (logior xcb:keysyms:meta-mask mods)))
+ ((or `lcontrol* `rcontrol*)
+ (setq xcb:keysyms:control-mask (logior xcb:keysyms:control-mask
+ mods)))
+ ((or `lshift* `rshift*)
+ (setq xcb:keysyms:shift-mask (logior xcb:keysyms:shift-mask
+ mods)))
+ ((or `lhyper* `rhyper*)
+ (setq xcb:keysyms:hyper-mask (logior xcb:keysyms:hyper-mask
+ mods)))
+ ((or `lsuper* `rsuper*)
+ (setq xcb:keysyms:super-mask (logior xcb:keysyms:super-mask
+ mods)))
+ ((or `caps-lock `shift-lock*)
+ (setq xcb:keysyms:lock-mask (logior xcb:keysyms:lock-mask mods)))
+ ((or `lalt* `ralt*)
+ (setq xcb:keysyms:alt-mask (logior xcb:keysyms:alt-mask
+ mods))))))))
+ ;; Meta fallbacks to Alt.
+ (unless (/= 0 xcb:keysyms:meta-mask)
+ (setq xcb:keysyms:meta-mask xcb:keysyms:alt-mask
+ xcb:keysyms:alt-mask 0))
+ ;; A key cannot be both Meta and Alt.
+ (when (and (/= 0 xcb:keysyms:meta-mask)
+ (/= 0 xcb:keysyms:alt-mask)
+ (/= 0 (logand xcb:keysyms:meta-mask xcb:keysyms:alt-mask)))
+ (setq xcb:keysyms:alt-mask (logand xcb:keysyms:alt-mask
+ (lognot xcb:keysyms:meta-mask)))))
+
+(cl-defmethod xcb:keysyms:keycode->keysym ((_obj xcb:connection) keycode
+ modifiers)
+ "Convert keycode to (keysym . mod-mask).
+
+Return (0 . 0) when conversion fails."
+ (let ((preserve 0)
+ group group-info group-number index keytype)
+ ;; Reference: `XkbTranslateKeyCode' in 'XKBBind.c'.
+ (catch 'return
+ ;; Check keycode range.
+ (unless (<= xcb:keysyms:-min-keycode keycode xcb:keysyms:-max-keycode)
+ (throw 'return '(0 . 0)))
+ ;; Retrieve KeySymMap and group info.
+ (setq keycode (aref xcb:keysyms:-keycodes
+ (- keycode xcb:keysyms:-min-keycode))
+ group-info (slot-value keycode 'groupInfo)
+ group-number (logand group-info #xF)) ; See <XKBstr.h>.
+ ;; Check group number.
+ (when (= group-number 0)
+ (throw 'return '(0 . 0)))
+ (setq group (logand (lsh modifiers -13) #b11)) ;The 13, 14 bits.
+ ;; Wrap group.
+ (when (>= group group-number)
+ (pcase (logand group-info #xC0) ;See <XKBstr.h>.
+ (`xcb:xkb:GroupsWrap:RedirectIntoRange
+ (setq group (logand #xFF (lsh group-info -4))) ;See <XKBstr.h>.
+ ;; Check if i's also out of range.
+ (when (>= group group-number)
+ (setq group 0)))
+ (`xcb:xkb:GroupsWrap:ClampIntoRange
+ (setq group (1- group-number)))
+ (_
+ (setq group (% group group-number)))))
+ ;; Calculate the index of keysym.
+ (setq index (* group (slot-value keycode 'width)))
+ ;; Get key type.
+ (setq keytype (aref xcb:keysyms:-keytypes
+ (elt (slot-value keycode 'kt-index) group)))
+ ;; Find the shift level and preserved modifiers.
+ (with-slots (mods-mask hasPreserve map (preserve* preserve)) keytype
+ (catch 'break
+ (dolist (entry map)
+ (with-slots (active (mods-mask* mods-mask) level) entry
+ (when (and (= 1 active)
+ (= (logand modifiers mods-mask) mods-mask*))
+ (cl-incf index level)
+ (when (= 1 hasPreserve)
+ (setq preserve (slot-value (elt preserve*
+ (cl-position entry map))
+ 'mask)))
+ (throw 'break nil)))))
+ ;; FIXME: Use of preserved modifiers (e.g. capitalize the keysym
+ ;; when LOCK is preserved)?
+ (cons (elt (slot-value keycode 'syms) index)
+ (logand mods-mask (lognot preserve)))))))
+
+(cl-defmethod xcb:keysyms:keysym->keycode ((_obj xcb:connection) keysym)
+ "Convert keysym to (the first matching) keycode.
+
+Return 0 if conversion fails."
+ (let ((index 0)
+ (continue t))
+ ;; Traverse all keycodes, column by column.
+ ;; Reference: `XKeysymToKeycode' in 'XKBBind.c'.
+ (catch 'break
+ (when (= 0 keysym)
+ (throw 'break 0))
+ (while continue
+ (setq continue nil)
+ (dotimes (i (- xcb:keysyms:-max-keycode xcb:keysyms:-min-keycode -1))
+ (with-slots (nSyms syms) (aref xcb:keysyms:-keycodes i)
+ (when (< index nSyms)
+ (setq continue t)
+ (when (= keysym (elt syms index))
+ (throw 'break (+ i xcb:keysyms:-min-keycode))))))
+ (cl-incf index))
+ 0)))
;; This list is largely base on 'lispy_function_keys' in 'keyboard.c'.
-;; Emacs has a built-in variable `x-keysym-table' providing Latin-1 and legacy
-;; keysyms, which seems not very useful here.
(defconst xcb:keysyms:-function-keys
`[ ;#xff00 - #xff0f
,@(make-list 8 nil) backspace tab linefeed clear nil return nil nil
@@ -347,9 +542,9 @@ SHIFT LOCK is ignored."
"Emacs event representations of XF86keysym (#x1008ff00 - #x1008ffff)")
(cl-defmethod xcb:keysyms:event->keysym ((obj xcb:connection) event)
- "Translate Emacs key event EVENT to X Keysym.
+ "Translate Emacs key event EVENT to (keysym . mod-mask).
-This function returns nil when it fails to convert an event."
+Return (0 . 0) when conversion fails."
(let ((modifiers (event-modifiers event))
(event (event-basic-type event))
keysym)
@@ -361,30 +556,48 @@ This function returns nil when it fails to convert an
event."
(`mouse-3 xcb:ButtonIndex:3)
(`mouse-4 xcb:ButtonIndex:4)
(`mouse-5 xcb:ButtonIndex:5)
- (_ (if (setq keysym (cl-position event
- xcb:keysyms:-function-keys))
- ;; Function keys
- (logior keysym #xff00)
- (if (setq keysym (cl-position event
- xcb:keysyms:-xf86-keys))
- ;; XF86 keys
- (logior keysym #x1008ff00)
- (if (setq keysym
- (cl-position event
- xcb:keysyms:-iso-function-keys))
- ;; ISO function keys
- (logior keysym #xfe00)))))))
- (if (<= #x20 event #xff) ;Latin-1
- (setq keysym event)
- (when (<= #x100 event #x10ffff) ;Unicode
- (setq keysym (+ #x1000000 event)))))
- (when keysym
+ (_
+ (cond
+ ((setq keysym (cl-position event
+ xcb:keysyms:-function-keys))
+ ;; Function keys.
+ (logior keysym #xff00))
+ ((setq keysym (cl-position event xcb:keysyms:-xf86-keys))
+ ;; XF86 keys.
+ (logior keysym #x1008ff00))
+ ((setq keysym (cl-position event
+ xcb:keysyms:-iso-function-keys))
+ ;; ISO function keys.
+ (logior keysym #xfe00))
+ (t
+ ;; Finally try system-specific keysyms.
+ (car (rassq event system-key-alist)))))))
+ (setq keysym
+ (cond
+ ((<= #x20 event #xff)
+ ;; Latin-1.
+ event)
+ ((<= #x100 event #x10ffff)
+ ;; Unicode.
+ (+ #x1000000 event))
+ (t (or
+ ;; Try system-specific keysyms.
+ (car (rassq event system-key-alist))
+ ;; Try legacy keysyms.
+ (catch 'break
+ (maphash (lambda (key val)
+ (when (= event val)
+ (throw 'break key)))
+ x-keysym-table)))))))
+ (if (not keysym)
+ '(0 . 0)
(let ((keycode (xcb:keysyms:keysym->keycode obj keysym))
- (keysyms (plist-get (slot-value obj 'extra-plist) 'keysyms)))
- (unless (or (not keycode)
- (equal keysym (cdr (assoc keycode keysyms))))
- ;; Shift key is required to input the KEYSYM
- (cl-pushnew 'shift modifiers)))
+ keysym*)
+ (when (/= 0 keycode)
+ (setq keysym* (xcb:keysyms:keycode->keysym obj keycode 0))
+ (unless (= keysym (car keysym*))
+ ;; This keysym requires additional modifiers to input.
+ (push (cdr keysym*) modifiers))))
(when modifiers
;; Do transforms: * -> x-*-keysym -> xcb:keysyms:*-mask.
(setq modifiers (mapcar (lambda (i)
@@ -397,20 +610,18 @@ This function returns nil when it fails to convert an
event."
modifiers)
modifiers (mapcar (lambda (i)
(pcase i
+ ((and x (pred integerp)) x)
(`meta xcb:keysyms:meta-mask)
(`control xcb:keysyms:control-mask)
(`shift xcb:keysyms:shift-mask)
(`hyper xcb:keysyms:hyper-mask)
(`super xcb:keysyms:super-mask)
(`alt xcb:keysyms:alt-mask)
- (`down 0)
- ;; FIXME: more?
- (_ 0)))
+ (_
+ ;; Include but not limit to: down.
+ 0)))
modifiers)))
- (unless (memq nil modifiers)
- `(,keysym
- ;; state for KeyPress event
- ,(apply #'logior modifiers))))))
+ (cons keysym (apply #'logior modifiers)))))
(cl-defmethod xcb:keysyms:keysym->event ((_obj xcb:connection) keysym
&optional mask allow-modifiers)
@@ -418,6 +629,9 @@ This function returns nil when it fails to convert an
event."
One may use MASK to provide modifier keys. If ALLOW-MODIFIERS is non-nil,
this function will also return symbols for pure modifiers keys."
+ ;; Convert nil to 0.
+ (unless mask
+ (setq mask 0))
(let ((event (cond ((<= #x20 keysym #xff)
keysym)
((<= #xff00 keysym #xffff)
@@ -430,11 +644,16 @@ this function will also return symbols for pure modifiers
keys."
(aref xcb:keysyms:-xf86-keys (logand keysym #xff)))
((<= #xfe00 keysym #xfeff)
(aref xcb:keysyms:-iso-function-keys
- (logand keysym #xff)))))
+ (logand keysym #xff)))
+ (t (or
+ ;; Search system-specific keysyms.
+ (car (assq keysym system-key-alist))
+ ;; Search `x-keysym-table' for legacy keysyms.
+ (gethash keysym x-keysym-table)))))
mod-alt mod-meta mod-hyper mod-super)
(when event
(if allow-modifiers
- (when mask
+ (when (/= 0 mask)
;; Clear modifier bits for modifier keys.
(pcase event
((or `lmeta* `rmeta*)
@@ -444,13 +663,11 @@ this function will also return symbols for pure modifiers
keys."
((or `lshift* `rshift*)
(setq mask (logand mask (lognot xcb:keysyms:shift-mask))))
((or `lhyper* `rhyper*)
- (when xcb:keysyms:hyper-mask
- (setq mask (logand mask (lognot xcb:keysyms:hyper-mask)))))
+ (setq mask (logand mask (lognot xcb:keysyms:hyper-mask))))
((or `lsuper* `rsuper*)
(setq mask (logand mask (lognot xcb:keysyms:super-mask))))
((or `lalt* `ralt*)
- (when xcb:keysyms:alt-mask
- (setq mask (logand mask (lognot xcb:keysyms:alt-mask)))))))
+ (setq mask (logand mask (lognot xcb:keysyms:alt-mask))))))
(when (memq event
'(lshift*
rshift*
@@ -470,7 +687,7 @@ this function will also return symbols for pure modifiers
keys."
kp-numlock))
(setq event nil))))
(when event
- (if (not mask)
+ (if (= 0 mask)
event
;; Set mod-* if possible.
(when x-alt-keysym
@@ -503,13 +720,11 @@ this function will also return symbols for pure modifiers
keys."
(or (not (<= #x20 keysym #xff)) ;Not a Latin-1 character
(<= ?A keysym ?Z))) ;An uppercase letter
(push 'shift event))
- (when (and xcb:keysyms:hyper-mask
- (/= 0 (logand mask xcb:keysyms:hyper-mask)))
+ (when (/= 0 (logand mask xcb:keysyms:hyper-mask))
(push (or mod-hyper 'hyper) event))
(when (/= 0 (logand mask xcb:keysyms:super-mask))
(push (or mod-super 'super) event))
- (when (and xcb:keysyms:alt-mask
- (/= 0 (logand mask xcb:keysyms:alt-mask)))
+ (when (/= 0 (logand mask xcb:keysyms:alt-mask))
(push (or mod-alt 'alt) event))
(event-convert-list event)))))
diff --git a/xcb-randr.el b/xcb-randr.el
index ccb96ee..8d2c7c0 100644
--- a/xcb-randr.el
+++ b/xcb-randr.el
@@ -963,7 +963,8 @@
(defclass xcb:randr:NotifyData
(xcb:-union)
- ((cc :initarg :cc :type xcb:randr:CrtcChange)
+ ((~size :initform 28)
+ (cc :initarg :cc :type xcb:randr:CrtcChange)
(oc :initarg :oc :type xcb:randr:OutputChange)
(op :initarg :op :type xcb:randr:OutputProperty)
(pc :initarg :pc :type xcb:randr:ProviderChange)
diff --git a/xcb-render.el b/xcb-render.el
index 7cb6f51..4be4fc1 100644
--- a/xcb-render.el
+++ b/xcb-render.el
@@ -316,19 +316,19 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:render:CP:Repeat repeat)
- (xcb:render:CP:AlphaMap alphamap)
- (xcb:render:CP:AlphaXOrigin alphaxorigin)
- (xcb:render:CP:AlphaYOrigin alphayorigin)
- (xcb:render:CP:ClipXOrigin clipxorigin)
- (xcb:render:CP:ClipYOrigin clipyorigin)
- (xcb:render:CP:ClipMask clipmask)
- (xcb:render:CP:GraphicsExposure graphicsexposure)
- (xcb:render:CP:SubwindowMode subwindowmode)
- (xcb:render:CP:PolyEdge polyedge)
- (xcb:render:CP:PolyMode polymode)
- (xcb:render:CP:Dither dither)
- (xcb:render:CP:ComponentAlpha componentalpha)))
+ ((1 repeat)
+ (2 alphamap)
+ (4 alphaxorigin)
+ (8 alphayorigin)
+ (16 clipxorigin)
+ (32 clipyorigin)
+ (64 clipmask)
+ (128 graphicsexposure)
+ (256 subwindowmode)
+ (512 polyedge)
+ (1024 polymode)
+ (2048 dither)
+ (4096 componentalpha)))
:type xcb:-switch)
(repeat :initarg :repeat :type xcb:CARD32)
(alphamap :initarg :alphamap :type xcb:render:PICTURE)
@@ -353,19 +353,19 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:render:CP:Repeat repeat)
- (xcb:render:CP:AlphaMap alphamap)
- (xcb:render:CP:AlphaXOrigin alphaxorigin)
- (xcb:render:CP:AlphaYOrigin alphayorigin)
- (xcb:render:CP:ClipXOrigin clipxorigin)
- (xcb:render:CP:ClipYOrigin clipyorigin)
- (xcb:render:CP:ClipMask clipmask)
- (xcb:render:CP:GraphicsExposure graphicsexposure)
- (xcb:render:CP:SubwindowMode subwindowmode)
- (xcb:render:CP:PolyEdge polyedge)
- (xcb:render:CP:PolyMode polymode)
- (xcb:render:CP:Dither dither)
- (xcb:render:CP:ComponentAlpha componentalpha)))
+ ((1 repeat)
+ (2 alphamap)
+ (4 alphaxorigin)
+ (8 alphayorigin)
+ (16 clipxorigin)
+ (32 clipyorigin)
+ (64 clipmask)
+ (128 graphicsexposure)
+ (256 subwindowmode)
+ (512 polyedge)
+ (1024 polymode)
+ (2048 dither)
+ (4096 componentalpha)))
:type xcb:-switch)
(repeat :initarg :repeat :type xcb:CARD32)
(alphamap :initarg :alphamap :type xcb:render:PICTURE)
diff --git a/xcb-screensaver.el b/xcb-screensaver.el
index 3375689..b7645f1 100644
--- a/xcb-screensaver.el
+++ b/xcb-screensaver.el
@@ -95,21 +95,21 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:CW:BackPixmap background-pixmap)
- (xcb:CW:BackPixel background-pixel)
- (xcb:CW:BorderPixmap border-pixmap)
- (xcb:CW:BorderPixel border-pixel)
- (xcb:CW:BitGravity bit-gravity)
- (xcb:CW:WinGravity win-gravity)
- (xcb:CW:BackingStore backing-store)
- (xcb:CW:BackingPlanes backing-planes)
- (xcb:CW:BackingPixel backing-pixel)
- (xcb:CW:OverrideRedirect override-redirect)
- (xcb:CW:SaveUnder save-under)
- (xcb:CW:EventMask event-mask)
- (xcb:CW:DontPropagate do-not-propogate-mask)
- (xcb:CW:Colormap colormap)
- (xcb:CW:Cursor cursor)))
+ ((1 background-pixmap)
+ (2 background-pixel)
+ (4 border-pixmap)
+ (8 border-pixel)
+ (16 bit-gravity)
+ (32 win-gravity)
+ (64 backing-store)
+ (128 backing-planes)
+ (256 backing-pixel)
+ (512 override-redirect)
+ (1024 save-under)
+ (2048 event-mask)
+ (4096 do-not-propogate-mask)
+ (8192 colormap)
+ (16384 cursor)))
:type xcb:-switch)
(background-pixmap :initarg :background-pixmap :type xcb:PIXMAP)
(background-pixel :initarg :background-pixel :type xcb:CARD32)
diff --git a/xcb-sync.el b/xcb-sync.el
index b50e845..96f627d 100644
--- a/xcb-sync.el
+++ b/xcb-sync.el
@@ -174,12 +174,12 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:sync:CA:Counter counter)
- (xcb:sync:CA:ValueType valueType)
- (xcb:sync:CA:Value value)
- (xcb:sync:CA:TestType testType)
- (xcb:sync:CA:Delta delta)
- (xcb:sync:CA:Events events)))
+ ((1 counter)
+ (2 valueType)
+ (4 value)
+ (8 testType)
+ (16 delta)
+ (32 events)))
:type xcb:-switch)
(counter :initarg :counter :type xcb:sync:COUNTER)
(valueType :initarg :valueType :type xcb:CARD32)
@@ -197,12 +197,12 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:sync:CA:Counter counter)
- (xcb:sync:CA:ValueType valueType)
- (xcb:sync:CA:Value value)
- (xcb:sync:CA:TestType testType)
- (xcb:sync:CA:Delta delta)
- (xcb:sync:CA:Events events)))
+ ((1 counter)
+ (2 valueType)
+ (4 value)
+ (8 testType)
+ (16 delta)
+ (32 events)))
:type xcb:-switch)
(counter :initarg :counter :type xcb:sync:COUNTER)
(valueType :initarg :valueType :type xcb:CARD32)
diff --git a/xcb-types.el b/xcb-types.el
index f4e41f0..8d4e9a2 100644
--- a/xcb-types.el
+++ b/xcb-types.el
@@ -91,6 +91,10 @@
(unless (fboundp 'eieio-slot-descriptor-name)
(defsubst eieio-slot-descriptor-name (slot) (aref slot 0))))
+(eval-and-compile
+ (unless (fboundp 'cl--slot-descriptor-initform)
+ (defsubst cl--slot-descriptor-initform (slot) (aref slot 1))))
+
(eval-when-compile
(unless (fboundp 'cl--slot-descriptor-type)
(defsubst cl--slot-descriptor-type (slot) (aref slot 2))))
@@ -516,15 +520,13 @@ The optional POS argument indicates current byte index of
the field (used by
(setq condition (car i))
(setq name-list (cdr i))
(setq flag nil)
- (if (symbolp condition)
- (setq condition (symbol-value condition))
- (when (and (listp condition) (eq 'logior (car condition)))
- (setq condition (apply #'logior (cdr condition)))))
(cl-assert (or (integerp condition) (listp condition)))
(if (integerp condition)
(setq flag (/= 0 (logand expression condition)))
- (while (and (not flag) condition)
- (setq flag (or flag (= expression (pop condition))))))
+ (if (eq 'logior (car condition))
+ (setq flag (/= 0 (logand expression
+ (apply #'logior (cdr condition)))))
+ (setq flag (memq expression condition))))
(when flag
(dolist (name name-list)
(catch 'break
@@ -532,11 +534,13 @@ The optional POS argument indicates current byte index of
the field (used by
(when (eq name (eieio-slot-descriptor-name slot))
(setq slot-type (cl--slot-descriptor-type slot))
(throw 'break nil))))
- (setq result
- (vconcat result
- (xcb:-marshal-field obj slot-type
- (slot-value obj name)
- (+ pos (length result))))))))
+ (unless (eq slot-type 'xcb:-ignore)
+ (setq result
+ (vconcat result
+ (xcb:-marshal-field obj slot-type
+ (slot-value obj name)
+ (+ pos
+ (length result)))))))))
result))
((guard (child-of-class-p type 'xcb:-struct))
(xcb:marshal value))
@@ -652,13 +656,13 @@ and the second the consumed length."
(setq condition (car i))
(setq name-list (cdr i))
(setq flag nil)
+ (cl-assert (or (integerp condition) (listp condition)))
(if (integerp condition)
(setq flag (/= 0 (logand expression condition)))
(if (eq 'logior (car condition))
(setq flag (/= 0 (logand expression
(apply #'logior (cdr condition)))))
- (while (and (not flag) condition)
- (setq flag (or flag (= expression (pop condition)))))))
+ (setq flag (memq expression condition))))
(when flag
(dolist (name name-list)
(catch 'break
@@ -666,10 +670,12 @@ and the second the consumed length."
(when (eq name (eieio-slot-descriptor-name slot))
(setq slot-type (cl--slot-descriptor-type slot))
(throw 'break nil))))
- (setq tmp (xcb:-unmarshal-field obj slot-type data offset nil))
- (setf (slot-value obj name) (car tmp))
- (setq count (+ count (cadr tmp)))
- (setq data (substring data (cadr tmp))))))
+ (unless (eq slot-type 'xcb:-ignore)
+ (setq tmp (xcb:-unmarshal-field obj slot-type data offset
+ (eieio-oref-default obj name)))
+ (setf (slot-value obj name) (car tmp))
+ (setq count (+ count (cadr tmp)))
+ (setq data (substring data (cadr tmp)))))))
(list initform count)))
((and x (guard (child-of-class-p x 'xcb:-struct)))
(let* ((struct-obj (make-instance x))
@@ -741,7 +747,7 @@ Note that this method auto pads the result to 32 bytes, as
is always the case."
(cl-call-next-method obj (substring byte-array 4))) ;skip the first 4 bytes
(defclass xcb:-union (xcb:-struct)
- nil
+ ((~size :initarg :~size :type xcb:-ignore)) ;Size of the largest member.
:documentation "Union type.")
;;
(cl-defmethod xcb:marshal ((obj xcb:-union))
@@ -749,8 +755,9 @@ Note that this method auto pads the result to 32 bytes, as
is always the case."
This result is converted from the first bounded slot."
(let ((slots (eieio-class-slots (eieio-object-class obj)))
- result slot type name)
- (while (and (not result) slots)
+ (size (slot-value obj '~size))
+ result slot type name tmp)
+ (while (and (not result) slots (> size (length result)))
(setq slot (pop slots))
(setq type (cl--slot-descriptor-type slot)
name (eieio-slot-descriptor-name slot))
@@ -760,9 +767,12 @@ This result is converted from the first bounded slot."
(and (eq type 'xcb:-list)
(not (slot-boundp obj (plist-get (slot-value obj name)
'name)))))
- (setq result (xcb:-marshal-field obj
- (cl--slot-descriptor-type slot)
- (slot-value obj name)))))
+ (setq tmp (xcb:-marshal-field obj (cl--slot-descriptor-type slot)
+ (slot-value obj name)))
+ (when (> (length tmp) (length result))
+ (setq result tmp))))
+ (when (> size (length result))
+ (setq result (vconcat result (make-vector (- size (length result)) 0))))
result))
;;
(cl-defmethod xcb:unmarshal ((obj xcb:-union) byte-array &optional ctx)
@@ -770,7 +780,7 @@ This result is converted from the first bounded slot."
The optional argument CTX is for <paramref>."
(let ((slots (eieio-class-slots (eieio-object-class obj)))
- slot-name consumed tmp type)
+ slot-name tmp type)
(dolist (slot slots)
(setq type (cl--slot-descriptor-type slot))
(unless (eq type 'xcb:-ignore)
@@ -779,9 +789,8 @@ The optional argument CTX is for <paramref>."
(when (slot-boundp obj slot-name)
(eieio-oref-default obj slot-name))
ctx))
- (setf (slot-value obj (eieio-slot-descriptor-name slot)) (car tmp))
- (setq consumed (cadr tmp))))
- consumed)) ;consume byte-array only once
+ (setf (slot-value obj (eieio-slot-descriptor-name slot)) (car tmp))))
+ (slot-value obj '~size)))
diff --git a/xcb-xf86vidmode.el b/xcb-xf86vidmode.el
index a4b20b4..c07aa32 100644
--- a/xcb-xf86vidmode.el
+++ b/xcb-xf86vidmode.el
@@ -176,9 +176,7 @@
(+
(xcb:-fieldref 'vendor-length)
3)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node))))
+ (lognot 3))
(xcb:-fieldref 'vendor-length)))
:type xcb:-list)
(pad~5 :initform 4 :type xcb:-pad-align)
@@ -413,9 +411,7 @@
(+
(xcb:-fieldref 'size)
1)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node)))))
+ (lognot 1)))
:type xcb:-list)
(pad~2 :initform 4 :type xcb:-pad-align)
(green :initarg :green :type xcb:-ignore)
@@ -425,9 +421,7 @@
(+
(xcb:-fieldref 'size)
1)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node)))))
+ (lognot 1)))
:type xcb:-list)
(pad~3 :initform 4 :type xcb:-pad-align)
(blue :initarg :blue :type xcb:-ignore)
@@ -437,9 +431,7 @@
(+
(xcb:-fieldref 'size)
1)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node)))))
+ (lognot 1)))
:type xcb:-list)))
(defclass xcb:xf86vidmode:SetGammaRamp
@@ -454,9 +446,7 @@
(+
(xcb:-fieldref 'size)
1)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node)))))
+ (lognot 1)))
:type xcb:-list)
(pad~0 :initform 4 :type xcb:-pad-align)
(green :initarg :green :type xcb:-ignore)
@@ -466,9 +456,7 @@
(+
(xcb:-fieldref 'size)
1)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node)))))
+ (lognot 1)))
:type xcb:-list)
(pad~1 :initform 4 :type xcb:-pad-align)
(blue :initarg :blue :type xcb:-ignore)
@@ -478,9 +466,7 @@
(+
(xcb:-fieldref 'size)
1)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node)))))
+ (lognot 1)))
:type xcb:-list)))
(defclass xcb:xf86vidmode:GetGammaRampSize
diff --git a/xcb-xinput.el b/xcb-xinput.el
index 578d1e2..d33d9ca 100644
--- a/xcb-xinput.el
+++ b/xcb-xinput.el
@@ -133,12 +133,9 @@
'(expression
(xcb:-fieldref 'class-id)
cases
- (((xcb:xinput:InputClass:Key)
- min-keycode max-keycode num-keys pad~0)
- ((xcb:xinput:InputClass:Button)
- num-buttons)
- ((xcb:xinput:InputClass:Valuator)
- axes-len mode motion-size axes)))
+ ((0 min-keycode max-keycode num-keys pad~0)
+ (1 num-buttons)
+ (2 axes-len mode motion-size axes)))
:type xcb:-switch)
(min-keycode :initarg :min-keycode :type xcb:xinput:KeyCode)
(max-keycode :initarg :max-keycode :type xcb:xinput:KeyCode)
@@ -567,18 +564,12 @@
'(expression
(xcb:-fieldref 'class-id)
cases
- (((xcb:xinput:FeedbackClass:Keyboard)
- pitch duration led-mask led-values global-auto-repeat click
percent pad~0 auto-repeats)
- ((xcb:xinput:FeedbackClass:Pointer)
- pad~1 accel-num accel-denom threshold)
- ((xcb:xinput:FeedbackClass:String)
- max-symbols num-keysyms keysyms)
- ((xcb:xinput:FeedbackClass:Integer)
- resolution min-value max-value)
- ((xcb:xinput:FeedbackClass:Led)
- led-mask* led-values*)
- ((xcb:xinput:FeedbackClass:Bell)
- percent* pad~2 pitch* duration*)))
+ ((0 pitch duration led-mask led-values global-auto-repeat click
percent pad~0 auto-repeats)
+ (1 pad~1 accel-num accel-denom threshold)
+ (2 max-symbols num-keysyms keysyms)
+ (3 resolution min-value max-value)
+ (4 led-mask* led-values*)
+ (5 percent* pad~2 pitch* duration*)))
:type xcb:-switch)
(pitch :initarg :pitch :type xcb:CARD16)
(duration :initarg :duration :type xcb:CARD16)
@@ -700,18 +691,12 @@
'(expression
(xcb:-fieldref 'class-id)
cases
- (((xcb:xinput:FeedbackClass:Keyboard)
- key auto-repeat-mode key-click-percent bell-percent bell-pitch
bell-duration led-mask led-values)
- ((xcb:xinput:FeedbackClass:Pointer)
- pad~0 num denom threshold)
- ((xcb:xinput:FeedbackClass:String)
- pad~1 num-keysyms keysyms)
- ((xcb:xinput:FeedbackClass:Integer)
- int-to-display)
- ((xcb:xinput:FeedbackClass:Led)
- led-mask* led-values*)
- ((xcb:xinput:FeedbackClass:Bell)
- percent pad~2 pitch duration)))
+ ((0 key auto-repeat-mode key-click-percent bell-percent bell-pitch
bell-duration led-mask led-values)
+ (1 pad~0 num denom threshold)
+ (2 pad~1 num-keysyms keysyms)
+ (3 int-to-display)
+ (4 led-mask* led-values*)
+ (5 percent pad~2 pitch duration)))
:type xcb:-switch)
(key :initarg :key :type xcb:xinput:KeyCode)
(auto-repeat-mode :initarg :auto-repeat-mode :type xcb:CARD8)
@@ -912,12 +897,9 @@
'(expression
(xcb:-fieldref 'class-id)
cases
- (((xcb:xinput:InputClass:Key)
- num-keys pad~0 keys)
- ((xcb:xinput:InputClass:Button)
- num-buttons pad~1 buttons)
- ((xcb:xinput:InputClass:Valuator)
- num-valuators mode valuators)))
+ ((0 num-keys pad~0 keys)
+ (1 num-buttons pad~1 buttons)
+ (2 num-valuators mode valuators)))
:type xcb:-switch)
(num-keys :initarg :num-keys :type xcb:CARD8)
(pad~0 :initform 1 :type xcb:-pad)
@@ -1080,16 +1062,11 @@
'(expression
(xcb:-fieldref 'control-id)
cases
- (((xcb:xinput:DeviceControl:resolution)
- num-valuators resolution-values resolution-min resolution-max)
- ((xcb:xinput:DeviceControl:abs_calib)
- min-x max-x min-y max-y flip-x flip-y rotation button-threshold)
- ((xcb:xinput:DeviceControl:core)
- status iscore pad~2)
- ((xcb:xinput:DeviceControl:enable)
- enable pad~3)
- ((xcb:xinput:DeviceControl:abs_area)
- offset-x offset-y width height screen following)))
+ ((1 num-valuators resolution-values resolution-min resolution-max)
+ (2 min-x max-x min-y max-y flip-x flip-y rotation button-threshold)
+ (3 status iscore pad~2)
+ (4 enable pad~3)
+ (5 offset-x offset-y width height screen following)))
:type xcb:-switch)
(num-valuators :initarg :num-valuators :type xcb:CARD32)
(resolution-values :initarg :resolution-values :type xcb:-ignore)
@@ -1201,16 +1178,11 @@
'(expression
(xcb:-fieldref 'control-id)
cases
- (((xcb:xinput:DeviceControl:resolution)
- first-valuator num-valuators pad~0 resolution-values)
- ((xcb:xinput:DeviceControl:abs_calib)
- min-x max-x min-y max-y flip-x flip-y rotation button-threshold)
- ((xcb:xinput:DeviceControl:core)
- status pad~1)
- ((xcb:xinput:DeviceControl:enable)
- enable pad~2)
- ((xcb:xinput:DeviceControl:abs_area)
- offset-x offset-y width height screen following)))
+ ((1 first-valuator num-valuators pad~0 resolution-values)
+ (2 min-x max-x min-y max-y flip-x flip-y rotation button-threshold)
+ (3 status pad~1)
+ (4 enable pad~2)
+ (5 offset-x offset-y width height screen following)))
:type xcb:-switch)
(first-valuator :initarg :first-valuator :type xcb:CARD8)
(num-valuators :initarg :num-valuators :type xcb:CARD8)
@@ -1286,12 +1258,9 @@
'(expression
(xcb:-fieldref 'format)
cases
- (((xcb:xinput:PropertyFormat:8Bits)
- data8 pad~1)
- ((xcb:xinput:PropertyFormat:16Bits)
- data16 pad~2)
- ((xcb:xinput:PropertyFormat:32Bits)
- data32)))
+ ((8 data8 pad~1)
+ (16 data16 pad~2)
+ (32 data32)))
:type xcb:-switch)
(data8 :initarg :data8 :type xcb:-ignore)
(data8~ :initform
@@ -1341,12 +1310,9 @@
'(expression
(xcb:-fieldref 'format)
cases
- (((xcb:xinput:PropertyFormat:8Bits)
- data8 pad~1)
- ((xcb:xinput:PropertyFormat:16Bits)
- data16 pad~2)
- ((xcb:xinput:PropertyFormat:32Bits)
- data32)))
+ ((8 data8 pad~1)
+ (16 data16 pad~2)
+ (32 data32)))
:type xcb:-switch)
(data8 :initarg :data8 :type xcb:-ignore)
(data8~ :initform
@@ -1485,14 +1451,10 @@
'(expression
(xcb:-fieldref 'type)
cases
- (((xcb:xinput:HierarchyChangeType:AddMaster)
- name-len send-core enable name pad~0)
- ((xcb:xinput:HierarchyChangeType:RemoveMaster)
- deviceid return-mode pad~1 return-pointer return-keyboard)
- ((xcb:xinput:HierarchyChangeType:AttachSlave)
- deviceid* master)
- ((xcb:xinput:HierarchyChangeType:DetachSlave)
- deviceid** pad~2)))
+ ((1 name-len send-core enable name pad~0)
+ (2 deviceid return-mode pad~1 return-pointer return-keyboard)
+ (3 deviceid* master)
+ (4 deviceid** pad~2)))
:type xcb:-switch)
(name-len :initarg :name-len :type xcb:CARD16)
(send-core :initarg :send-core :type xcb:BOOL)
@@ -1701,16 +1663,11 @@
'(expression
(xcb:-fieldref 'type)
cases
- (((xcb:xinput:DeviceClassType:Key)
- num-keys keys)
- ((xcb:xinput:DeviceClassType:Button)
- num-buttons state labels)
- ((xcb:xinput:DeviceClassType:Valuator)
- number label min max value resolution mode pad~1)
- ((xcb:xinput:DeviceClassType:Scroll)
- number* scroll-type pad~2 flags increment)
- ((xcb:xinput:DeviceClassType:Touch)
- mode* num-touches)))
+ ((0 num-keys keys)
+ (1 num-buttons state labels)
+ (2 number label min max value resolution mode pad~1)
+ (3 number* scroll-type pad~2 flags increment)
+ (8 mode* num-touches)))
:type xcb:-switch)
(num-keys :initarg :num-keys :type xcb:CARD16)
(keys :initarg :keys :type xcb:-ignore)
@@ -1957,12 +1914,9 @@
'(expression
(xcb:-fieldref 'format)
cases
- (((xcb:xinput:PropertyFormat:8Bits)
- data8 pad~0)
- ((xcb:xinput:PropertyFormat:16Bits)
- data16 pad~1)
- ((xcb:xinput:PropertyFormat:32Bits)
- data32)))
+ ((8 data8 pad~0)
+ (16 data16 pad~1)
+ (32 data32)))
:type xcb:-switch)
(data8 :initarg :data8 :type xcb:-ignore)
(data8~ :initform
@@ -2011,12 +1965,9 @@
'(expression
(xcb:-fieldref 'format)
cases
- (((xcb:xinput:PropertyFormat:8Bits)
- data8 pad~2)
- ((xcb:xinput:PropertyFormat:16Bits)
- data16 pad~3)
- ((xcb:xinput:PropertyFormat:32Bits)
- data32)))
+ ((8 data8 pad~2)
+ (16 data16 pad~3)
+ (32 data32)))
:type xcb:-switch)
(data8 :initarg :data8 :type xcb:-ignore)
(data8~ :initform
diff --git a/xcb-xkb.el b/xcb-xkb.el
index 4d77cc2..3f315db 100644
--- a/xcb-xkb.el
+++ b/xcb-xkb.el
@@ -332,9 +332,7 @@
(+
(xcb:-fieldref 'length)
5)
- (lognot
- (xelb-parse-expression
- (xelb-node-subnode node))))
+ (lognot 3))
(+
(xcb:-fieldref 'length)
2)))
@@ -417,7 +415,8 @@
(defclass xcb:xkb:Behavior
(xcb:-union)
- ((common :initarg :common :type xcb:xkb:CommonBehavior)
+ ((~size :initform 2)
+ (common :initarg :common :type xcb:xkb:CommonBehavior)
(default :initarg :default :type xcb:xkb:DefaultBehavior)
(lock :initarg :lock :type xcb:xkb:LockBehavior)
(radioGroup :initarg :radioGroup :type xcb:xkb:RadioGroupBehavior)
@@ -864,7 +863,8 @@
(defclass xcb:xkb:Action
(xcb:-union)
- ((noaction :initarg :noaction :type xcb:xkb:SANoAction)
+ ((~size :initform 8)
+ (noaction :initarg :noaction :type xcb:xkb:SANoAction)
(setmods :initarg :setmods :type xcb:xkb:SASetMods)
(latchmods :initarg :latchmods :type xcb:xkb:SALatchMods)
(lockmods :initarg :lockmods :type xcb:xkb:SALockMods)
@@ -914,23 +914,21 @@
(xcb:-fieldref 'affectWhich)
(logand
(lognot
- (xelb-parse-expression
- (xelb-node-subnode node)))
+ (xcb:-fieldref 'clear))
(lognot
- (xelb-parse-expression
- (xelb-node-subnode node)))))
+ (xcb:-fieldref 'selectAll))))
cases
- ((xcb:xkb:EventType:NewKeyboardNotify affectNewKeyboard
newKeyboardDetails)
- (xcb:xkb:EventType:StateNotify affectState stateDetails)
- (xcb:xkb:EventType:ControlsNotify affectCtrls ctrlDetails)
- (xcb:xkb:EventType:IndicatorStateNotify affectIndicatorState
indicatorStateDetails)
- (xcb:xkb:EventType:IndicatorMapNotify affectIndicatorMap
indicatorMapDetails)
- (xcb:xkb:EventType:NamesNotify affectNames namesDetails)
- (xcb:xkb:EventType:CompatMapNotify affectCompat compatDetails)
- (xcb:xkb:EventType:BellNotify affectBell bellDetails)
- (xcb:xkb:EventType:ActionMessage affectMsgDetails msgDetails)
- (xcb:xkb:EventType:AccessXNotify affectAccessX accessXDetails)
- (xcb:xkb:EventType:ExtensionDeviceNotify affectExtDev
extdevDetails)))
+ ((1 affectNewKeyboard newKeyboardDetails)
+ (4 affectState stateDetails)
+ (8 affectCtrls ctrlDetails)
+ (16 affectIndicatorState indicatorStateDetails)
+ (32 affectIndicatorMap indicatorMapDetails)
+ (64 affectNames namesDetails)
+ (128 affectCompat compatDetails)
+ (256 affectBell bellDetails)
+ (512 affectMsgDetails msgDetails)
+ (1024 affectAccessX accessXDetails)
+ (2048 affectExtDev extdevDetails)))
:type xcb:-switch)
(affectNewKeyboard :initarg :affectNewKeyboard :type xcb:CARD16)
(newKeyboardDetails :initarg :newKeyboardDetails :type xcb:CARD16)
@@ -1144,14 +1142,14 @@
'(expression
(xcb:-fieldref 'present)
cases
- ((xcb:xkb:MapPart:KeyTypes types-rtrn)
- (xcb:xkb:MapPart:KeySyms syms-rtrn)
- (xcb:xkb:MapPart:KeyActions acts-rtrn-count pad~2 acts-rtrn-acts)
- (xcb:xkb:MapPart:KeyBehaviors behaviors-rtrn)
- (xcb:xkb:MapPart:VirtualMods vmods-rtrn pad~3)
- (xcb:xkb:MapPart:ExplicitComponents explicit-rtrn pad~4)
- (xcb:xkb:MapPart:ModifierMap modmap-rtrn pad~5)
- (xcb:xkb:MapPart:VirtualModMap vmodmap-rtrn)))
+ ((1 types-rtrn)
+ (2 syms-rtrn)
+ (16 acts-rtrn-count pad~2 acts-rtrn-acts)
+ (32 behaviors-rtrn)
+ (64 vmods-rtrn pad~3)
+ (8 explicit-rtrn pad~4)
+ (4 modmap-rtrn pad~5)
+ (128 vmodmap-rtrn)))
:type xcb:-switch)
(types-rtrn :initarg :types-rtrn :type xcb:-ignore)
(types-rtrn~ :initform
@@ -1237,14 +1235,14 @@
'(expression
(xcb:-fieldref 'present)
cases
- ((xcb:xkb:MapPart:KeyTypes types)
- (xcb:xkb:MapPart:KeySyms syms)
- (xcb:xkb:MapPart:KeyActions actionsCount pad~0 actions)
- (xcb:xkb:MapPart:KeyBehaviors behaviors)
- (xcb:xkb:MapPart:VirtualMods vmods pad~1)
- (xcb:xkb:MapPart:ExplicitComponents explicit)
- (xcb:xkb:MapPart:ModifierMap modmap)
- (xcb:xkb:MapPart:VirtualModMap vmodmap)))
+ ((1 types)
+ (2 syms)
+ (16 actionsCount pad~0 actions)
+ (32 behaviors)
+ (64 vmods pad~1)
+ (8 explicit)
+ (4 modmap)
+ (128 vmodmap)))
:type xcb:-switch)
(types :initarg :types :type xcb:-ignore)
(types~ :initform
@@ -1467,20 +1465,20 @@
'(expression
(xcb:-fieldref 'which)
cases
- ((xcb:xkb:NameDetail:Keycodes keycodesName)
- (xcb:xkb:NameDetail:Geometry geometryName)
- (xcb:xkb:NameDetail:Symbols symbolsName)
- (xcb:xkb:NameDetail:PhysSymbols physSymbolsName)
- (xcb:xkb:NameDetail:Types typesName)
- (xcb:xkb:NameDetail:Compat compatName)
- (xcb:xkb:NameDetail:KeyTypeNames typeNames)
- (xcb:xkb:NameDetail:KTLevelNames nLevelsPerType pad~1
ktLevelNames)
- (xcb:xkb:NameDetail:IndicatorNames indicatorNames)
- (xcb:xkb:NameDetail:VirtualModNames virtualModNames)
- (xcb:xkb:NameDetail:GroupNames groups)
- (xcb:xkb:NameDetail:KeyNames keyNames)
- (xcb:xkb:NameDetail:KeyAliases keyAliases)
- (xcb:xkb:NameDetail:RGNames radioGroupNames)))
+ ((1 keycodesName)
+ (2 geometryName)
+ (4 symbolsName)
+ (8 physSymbolsName)
+ (16 typesName)
+ (32 compatName)
+ (64 typeNames)
+ (128 nLevelsPerType pad~1 ktLevelNames)
+ (256 indicatorNames)
+ (2048 virtualModNames)
+ (4096 groups)
+ (512 keyNames)
+ (1024 keyAliases)
+ (8192 radioGroupNames)))
:type xcb:-switch)
(keycodesName :initarg :keycodesName :type xcb:ATOM)
(geometryName :initarg :geometryName :type xcb:ATOM)
@@ -1561,20 +1559,20 @@
'(expression
(xcb:-fieldref 'which)
cases
- ((xcb:xkb:NameDetail:Keycodes keycodesName)
- (xcb:xkb:NameDetail:Geometry geometryName)
- (xcb:xkb:NameDetail:Symbols symbolsName)
- (xcb:xkb:NameDetail:PhysSymbols physSymbolsName)
- (xcb:xkb:NameDetail:Types typesName)
- (xcb:xkb:NameDetail:Compat compatName)
- (xcb:xkb:NameDetail:KeyTypeNames typeNames)
- (xcb:xkb:NameDetail:KTLevelNames nLevelsPerType pad~1
ktLevelNames)
- (xcb:xkb:NameDetail:IndicatorNames indicatorNames)
- (xcb:xkb:NameDetail:VirtualModNames virtualModNames)
- (xcb:xkb:NameDetail:GroupNames groups)
- (xcb:xkb:NameDetail:KeyNames keyNames)
- (xcb:xkb:NameDetail:KeyAliases keyAliases)
- (xcb:xkb:NameDetail:RGNames radioGroupNames)))
+ ((1 keycodesName)
+ (2 geometryName)
+ (4 symbolsName)
+ (8 physSymbolsName)
+ (16 typesName)
+ (32 compatName)
+ (64 typeNames)
+ (128 nLevelsPerType pad~1 ktLevelNames)
+ (256 indicatorNames)
+ (2048 virtualModNames)
+ (4096 groups)
+ (512 keyNames)
+ (1024 keyAliases)
+ (8192 radioGroupNames)))
:type xcb:-switch)
(keycodesName :initarg :keycodesName :type xcb:ATOM)
(geometryName :initarg :geometryName :type xcb:ATOM)
@@ -1712,6 +1710,13 @@
(want :initarg :want :type xcb:CARD16)
(load :initarg :load :type xcb:BOOL)
(pad~0 :initform 1 :type xcb:-pad)))
+(eval-and-compile
+ (when
+ (< emacs-major-version 25)
+ (fset 'xcb:-defclass
+ (symbol-function 'defclass))
+ (defmacro defclass
+ (&rest _args))))
(defclass xcb:xkb:GetKbdByName~reply
(xcb:-reply)
((deviceID :initarg :deviceID :type xcb:CARD8)
@@ -1726,13 +1731,11 @@
'(expression
(xcb:-fieldref 'reported)
cases
- (((logior xcb:xkb:GBNDetail:Types xcb:xkb:GBNDetail:ClientSymbols
xcb:xkb:GBNDetail:ServerSymbols)
- getmap-type typeDeviceID getmap-sequence getmap-length pad~1
typeMinKeyCode typeMaxKeyCode present firstType nTypes totalTypes firstKeySym
totalSyms nKeySyms firstKeyAction totalActions nKeyActions firstKeyBehavior
nKeyBehaviors totalKeyBehaviors firstKeyExplicit nKeyExplicit totalKeyExplicit
firstModMapKey nModMapKeys totalModMapKeys firstVModMapKey nVModMapKeys
totalVModMapKeys pad~2 virtualMods map)
- (xcb:xkb:GBNDetail:CompatMap compatmap-type compatDeviceID
compatmap-sequence compatmap-length groupsRtrn pad~7 firstSIRtrn nSIRtrn
nTotalSI pad~8 si-rtrn group-rtrn)
- (xcb:xkb:GBNDetail:IndicatorMaps indicatormap-type
indicatorDeviceID indicatormap-sequence indicatormap-length which
realIndicators nIndicators pad~10 maps)
- ((logior xcb:xkb:GBNDetail:KeyNames xcb:xkb:GBNDetail:OtherNames)
- keyname-type keyDeviceID keyname-sequence keyname-length which*
keyMinKeyCode keyMaxKeyCode nTypes* groupNames virtualMods* firstKey nKeys
indicators nRadioGroups nKeyAliases nKTLevels pad~11 valueList)
- (xcb:xkb:GBNDetail:Geometry geometry-type geometryDeviceID
geometry-sequence geometry-length name geometryFound pad~13 widthMM heightMM
nProperties nColors nShapes nSections nDoodads nKeyAliases* baseColorNdx
labelColorNdx labelFont)))
+ ((13 getmap-type typeDeviceID getmap-sequence getmap-length pad~1
typeMinKeyCode typeMaxKeyCode present firstType nTypes totalTypes firstKeySym
totalSyms nKeySyms firstKeyAction totalActions nKeyActions firstKeyBehavior
nKeyBehaviors totalKeyBehaviors firstKeyExplicit nKeyExplicit totalKeyExplicit
firstModMapKey nModMapKeys totalModMapKeys firstVModMapKey nVModMapKeys
totalVModMapKeys pad~2 virtualMods map)
+ (2 compatmap-type compatDeviceID compatmap-sequence
compatmap-length groupsRtrn pad~7 firstSIRtrn nSIRtrn nTotalSI pad~8 si-rtrn
group-rtrn)
+ (16 indicatormap-type indicatorDeviceID indicatormap-sequence
indicatormap-length which realIndicators nIndicators pad~10 maps)
+ (160 keyname-type keyDeviceID keyname-sequence keyname-length
which* keyMinKeyCode keyMaxKeyCode nTypes* groupNames virtualMods* firstKey
nKeys indicators nRadioGroups nKeyAliases nKTLevels pad~11 valueList)
+ (64 geometry-type geometryDeviceID geometry-sequence
geometry-length name geometryFound pad~13 widthMM heightMM nProperties nColors
nShapes nSections nDoodads nKeyAliases* baseColorNdx labelColorNdx labelFont)))
:type xcb:-switch)
(getmap-type :initarg :getmap-type :type xcb:CARD8)
(typeDeviceID :initarg :typeDeviceID :type xcb:CARD8)
@@ -1769,14 +1772,14 @@
'(expression
(xcb:-fieldref 'present)
cases
- ((xcb:xkb:MapPart:KeyTypes types-rtrn)
- (xcb:xkb:MapPart:KeySyms syms-rtrn)
- (xcb:xkb:MapPart:KeyActions acts-rtrn-count pad~3 acts-rtrn-acts)
- (xcb:xkb:MapPart:KeyBehaviors behaviors-rtrn)
- (xcb:xkb:MapPart:VirtualMods vmods-rtrn pad~4)
- (xcb:xkb:MapPart:ExplicitComponents explicit-rtrn pad~5)
- (xcb:xkb:MapPart:ModifierMap modmap-rtrn pad~6)
- (xcb:xkb:MapPart:VirtualModMap vmodmap-rtrn)))
+ ((1 types-rtrn)
+ (2 syms-rtrn)
+ (16 acts-rtrn-count pad~3 acts-rtrn-acts)
+ (32 behaviors-rtrn)
+ (64 vmods-rtrn pad~4)
+ (8 explicit-rtrn pad~5)
+ (4 modmap-rtrn pad~6)
+ (128 vmodmap-rtrn)))
:type xcb:-switch)
(types-rtrn :initarg :types-rtrn :type xcb:-ignore)
(types-rtrn~ :initform
@@ -1884,20 +1887,20 @@
'(expression
(xcb:-fieldref 'which)
cases
- ((xcb:xkb:NameDetail:Keycodes keycodesName)
- (xcb:xkb:NameDetail:Geometry geometryName)
- (xcb:xkb:NameDetail:Symbols symbolsName)
- (xcb:xkb:NameDetail:PhysSymbols physSymbolsName)
- (xcb:xkb:NameDetail:Types typesName)
- (xcb:xkb:NameDetail:Compat compatName)
- (xcb:xkb:NameDetail:KeyTypeNames typeNames)
- (xcb:xkb:NameDetail:KTLevelNames nLevelsPerType pad~12
ktLevelNames)
- (xcb:xkb:NameDetail:IndicatorNames indicatorNames)
- (xcb:xkb:NameDetail:VirtualModNames virtualModNames)
- (xcb:xkb:NameDetail:GroupNames groups)
- (xcb:xkb:NameDetail:KeyNames keyNames)
- (xcb:xkb:NameDetail:KeyAliases keyAliases)
- (xcb:xkb:NameDetail:RGNames radioGroupNames)))
+ ((1 keycodesName)
+ (2 geometryName)
+ (4 symbolsName)
+ (8 physSymbolsName)
+ (16 typesName)
+ (32 compatName)
+ (64 typeNames)
+ (128 nLevelsPerType pad~12 ktLevelNames)
+ (256 indicatorNames)
+ (2048 virtualModNames)
+ (4096 groups)
+ (512 keyNames)
+ (1024 keyAliases)
+ (8192 radioGroupNames)))
:type xcb:-switch)
(keycodesName :initarg :keycodesName :type xcb:ATOM)
(geometryName :initarg :geometryName :type xcb:ATOM)
@@ -1973,6 +1976,11 @@
(baseColorNdx :initarg :baseColorNdx :type xcb:CARD8)
(labelColorNdx :initarg :labelColorNdx :type xcb:CARD8)
(labelFont :initarg :labelFont :type xcb:xkb:CountedString16)))
+(eval-and-compile
+ (when
+ (< emacs-major-version 25)
+ (fset 'defclass
+ (symbol-function 'xcb:-defclass))))
(defclass xcb:xkb:GetDeviceInfo
(xcb:-request)
diff --git a/xcb-xproto.el b/xcb-xproto.el
index 92e4a22..58d55b8 100644
--- a/xcb-xproto.el
+++ b/xcb-xproto.el
@@ -686,7 +686,8 @@
(defclass xcb:ClientMessageData
(xcb:-union)
- ((data8 :initarg :data8 :type xcb:-ignore)
+ ((~size :initform 20)
+ (data8 :initarg :data8 :type xcb:-ignore)
(data8~ :initform
'(name data8 type xcb:CARD8 size 20)
:type xcb:-list)
@@ -853,21 +854,21 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:CW:BackPixmap background-pixmap)
- (xcb:CW:BackPixel background-pixel)
- (xcb:CW:BorderPixmap border-pixmap)
- (xcb:CW:BorderPixel border-pixel)
- (xcb:CW:BitGravity bit-gravity)
- (xcb:CW:WinGravity win-gravity)
- (xcb:CW:BackingStore backing-store)
- (xcb:CW:BackingPlanes backing-planes)
- (xcb:CW:BackingPixel backing-pixel)
- (xcb:CW:OverrideRedirect override-redirect)
- (xcb:CW:SaveUnder save-under)
- (xcb:CW:EventMask event-mask)
- (xcb:CW:DontPropagate do-not-propogate-mask)
- (xcb:CW:Colormap colormap)
- (xcb:CW:Cursor cursor)))
+ ((1 background-pixmap)
+ (2 background-pixel)
+ (4 border-pixmap)
+ (8 border-pixel)
+ (16 bit-gravity)
+ (32 win-gravity)
+ (64 backing-store)
+ (128 backing-planes)
+ (256 backing-pixel)
+ (512 override-redirect)
+ (1024 save-under)
+ (2048 event-mask)
+ (4096 do-not-propogate-mask)
+ (8192 colormap)
+ (16384 cursor)))
:type xcb:-switch)
(background-pixmap :initarg :background-pixmap :type xcb:PIXMAP)
(background-pixel :initarg :background-pixel :type xcb:CARD32)
@@ -895,21 +896,21 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:CW:BackPixmap background-pixmap)
- (xcb:CW:BackPixel background-pixel)
- (xcb:CW:BorderPixmap border-pixmap)
- (xcb:CW:BorderPixel border-pixel)
- (xcb:CW:BitGravity bit-gravity)
- (xcb:CW:WinGravity win-gravity)
- (xcb:CW:BackingStore backing-store)
- (xcb:CW:BackingPlanes backing-planes)
- (xcb:CW:BackingPixel backing-pixel)
- (xcb:CW:OverrideRedirect override-redirect)
- (xcb:CW:SaveUnder save-under)
- (xcb:CW:EventMask event-mask)
- (xcb:CW:DontPropagate do-not-propogate-mask)
- (xcb:CW:Colormap colormap)
- (xcb:CW:Cursor cursor)))
+ ((1 background-pixmap)
+ (2 background-pixel)
+ (4 border-pixmap)
+ (8 border-pixel)
+ (16 bit-gravity)
+ (32 win-gravity)
+ (64 backing-store)
+ (128 backing-planes)
+ (256 backing-pixel)
+ (512 override-redirect)
+ (1024 save-under)
+ (2048 event-mask)
+ (4096 do-not-propogate-mask)
+ (8192 colormap)
+ (16384 cursor)))
:type xcb:-switch)
(background-pixmap :initarg :background-pixmap :type xcb:PIXMAP)
(background-pixel :initarg :background-pixel :type xcb:CARD32)
@@ -1034,13 +1035,13 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:ConfigWindow:X x)
- (xcb:ConfigWindow:Y y)
- (xcb:ConfigWindow:Width width)
- (xcb:ConfigWindow:Height height)
- (xcb:ConfigWindow:BorderWidth border-width)
- (xcb:ConfigWindow:Sibling sibling)
- (xcb:ConfigWindow:StackMode stack-mode)))
+ ((1 x)
+ (2 y)
+ (4 width)
+ (8 height)
+ (16 border-width)
+ (32 sibling)
+ (64 stack-mode)))
:type xcb:-switch)
(x :initarg :x :type xcb:INT32)
(y :initarg :y :type xcb:INT32)
@@ -1768,29 +1769,29 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:GC:Function function)
- (xcb:GC:PlaneMask plane-mask)
- (xcb:GC:Foreground foreground)
- (xcb:GC:Background background)
- (xcb:GC:LineWidth line-width)
- (xcb:GC:LineStyle line-style)
- (xcb:GC:CapStyle cap-style)
- (xcb:GC:JoinStyle join-style)
- (xcb:GC:FillStyle fill-style)
- (xcb:GC:FillRule fill-rule)
- (xcb:GC:Tile tile)
- (xcb:GC:Stipple stipple)
- (xcb:GC:TileStippleOriginX tile-stipple-x-origin)
- (xcb:GC:TileStippleOriginY tile-stipple-y-origin)
- (xcb:GC:Font font)
- (xcb:GC:SubwindowMode subwindow-mode)
- (xcb:GC:GraphicsExposures graphics-exposures)
- (xcb:GC:ClipOriginX clip-x-origin)
- (xcb:GC:ClipOriginY clip-y-origin)
- (xcb:GC:ClipMask clip-mask)
- (xcb:GC:DashOffset dash-offset)
- (xcb:GC:DashList dashes)
- (xcb:GC:ArcMode arc-mode)))
+ ((1 function)
+ (2 plane-mask)
+ (4 foreground)
+ (8 background)
+ (16 line-width)
+ (32 line-style)
+ (64 cap-style)
+ (128 join-style)
+ (256 fill-style)
+ (512 fill-rule)
+ (1024 tile)
+ (2048 stipple)
+ (4096 tile-stipple-x-origin)
+ (8192 tile-stipple-y-origin)
+ (16384 font)
+ (32768 subwindow-mode)
+ (65536 graphics-exposures)
+ (131072 clip-x-origin)
+ (262144 clip-y-origin)
+ (524288 clip-mask)
+ (1048576 dash-offset)
+ (2097152 dashes)
+ (4194304 arc-mode)))
:type xcb:-switch)
(function :initarg :function :type xcb:CARD32)
(plane-mask :initarg :plane-mask :type xcb:CARD32)
@@ -1826,29 +1827,29 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:GC:Function function)
- (xcb:GC:PlaneMask plane-mask)
- (xcb:GC:Foreground foreground)
- (xcb:GC:Background background)
- (xcb:GC:LineWidth line-width)
- (xcb:GC:LineStyle line-style)
- (xcb:GC:CapStyle cap-style)
- (xcb:GC:JoinStyle join-style)
- (xcb:GC:FillStyle fill-style)
- (xcb:GC:FillRule fill-rule)
- (xcb:GC:Tile tile)
- (xcb:GC:Stipple stipple)
- (xcb:GC:TileStippleOriginX tile-stipple-x-origin)
- (xcb:GC:TileStippleOriginY tile-stipple-y-origin)
- (xcb:GC:Font font)
- (xcb:GC:SubwindowMode subwindow-mode)
- (xcb:GC:GraphicsExposures graphics-exposures)
- (xcb:GC:ClipOriginX clip-x-origin)
- (xcb:GC:ClipOriginY clip-y-origin)
- (xcb:GC:ClipMask clip-mask)
- (xcb:GC:DashOffset dash-offset)
- (xcb:GC:DashList dashes)
- (xcb:GC:ArcMode arc-mode)))
+ ((1 function)
+ (2 plane-mask)
+ (4 foreground)
+ (8 background)
+ (16 line-width)
+ (32 line-style)
+ (64 cap-style)
+ (128 join-style)
+ (256 fill-style)
+ (512 fill-rule)
+ (1024 tile)
+ (2048 stipple)
+ (4096 tile-stipple-x-origin)
+ (8192 tile-stipple-y-origin)
+ (16384 font)
+ (32768 subwindow-mode)
+ (65536 graphics-exposures)
+ (131072 clip-x-origin)
+ (262144 clip-y-origin)
+ (524288 clip-mask)
+ (1048576 dash-offset)
+ (2097152 dashes)
+ (4194304 arc-mode)))
:type xcb:-switch)
(function :initarg :function :type xcb:CARD32)
(plane-mask :initarg :plane-mask :type xcb:CARD32)
@@ -2559,14 +2560,14 @@
'(expression
(xcb:-fieldref 'value-mask)
cases
- ((xcb:KB:KeyClickPercent key-click-percent)
- (xcb:KB:BellPercent bell-percent)
- (xcb:KB:BellPitch bell-pitch)
- (xcb:KB:BellDuration bell-duration)
- (xcb:KB:Led led)
- (xcb:KB:LedMode led-mode)
- (xcb:KB:Key key)
- (xcb:KB:AutoRepeatMode auto-repeat-mode)))
+ ((1 key-click-percent)
+ (2 bell-percent)
+ (4 bell-pitch)
+ (8 bell-duration)
+ (16 led)
+ (32 led-mode)
+ (64 key)
+ (128 auto-repeat-mode)))
:type xcb:-switch)
(key-click-percent :initarg :key-click-percent :type xcb:INT32)
(bell-percent :initarg :bell-percent :type xcb:INT32)
diff --git a/xcb.el b/xcb.el
index a03dbb4..4cba47c 100644
--- a/xcb.el
+++ b/xcb.el
@@ -332,6 +332,9 @@ Concurrency is disabled as it breaks the orders of errors,
replies and events."
(when (/= 0 (logand x #x80)) ;synthetic event
(setq synthetic t
x (logand x #x7f))) ;low 7 bits is the event number
+ (when (<= 64 x 127)
+ ;; Extension event; add the second byte.
+ (cl-incf x (aref cache 1)))
(setq listener
(plist-get (slot-value connection 'event-plist) x))
(when listener
