branch: externals/xelb
commit a89d3b4b42b16e13be0e6a9789b97e49e58601a4
Author: Chris Feng <chris.w.f...@gmail.com>
Commit: Chris Feng <chris.w.f...@gmail.com>
Data types related fixes
* el_client.el (xelb-imports, xelb-parse-import): Save imported libs in new
variable `xelb-imports'.
(xelb-node-type, xelb-parse-field, xelb-parse-list, xelb-parse-exprfield):
Use new function `xelb-node-type' to search defined types.
* xcb-composite.el:
* xcb-damage.el:
* xcb-glx.el:
* xcb-present.el:
* xcb-randr.el:
* xcb-xfixes.el:
* xcb-xinput.el:
* xcb-xv.el:
* xcb-xvmc.el:
Data types corrected.
* xcb-types.el: Add new 8 bytes data types `xcb:-u8' and `xcb:CARD64'.
Define `xcb:-fd' as an alias of `xcb:-i4'.
(xcb:-pack-u8, xcb:-pack-u8-lsb, xcb:-unpack-u8, xcb:-unpack-u8-lsb):
New functions for packing/unpacking 8 bytes data on 64/32-bit machines.
* Makefile: Eliminate a warning.
---
Makefile | 19 ++++---
el_client.el | 46 ++++++++++++++----
xcb-composite.el | 2 +-
xcb-damage.el | 6 +-
xcb-glx.el | 6 +-
xcb-present.el | 44 ++++++++--------
xcb-randr.el | 12 ++--
xcb-types.el | 143 +++++++++++++++++++++++++++++++++++++++++++++++++++--
xcb-xfixes.el | 4 +-
xcb-xinput.el | 4 +-
xcb-xv.el | 2 +-
xcb-xvmc.el | 8 ++--
12 files changed, 228 insertions(+), 68 deletions(-)
diff --git a/Makefile b/Makefile
index 3f41490..da36c8a 100644
--- a/Makefile
+++ b/Makefile
@@ -2,26 +2,29 @@ PROTO_PATH := ../xcb-proto/src
EMACS_BIN := emacs -Q
-EXTENSIONS := bigreq dpms ge present render shape xf86dri xinerama xprint \
-xtest composite dri2 glx randr res shm xc_misc xf86vidmode xinput xvmc \
-damage dri3 record screensaver sync xevie xfixes xkb xselinux xv
+EXTENSIONS := bigreq composite damage dpms dri2 dri3 ge glx present randr \
+record render res screensaver shape shm sync xc_misc xevie xf86dri \
+xf86vidmode xfixes xinerama xinput xkb xprint xselinux xtest xvmc xv
-LIBS = xcb-xproto.el $(addprefix xcb-,$(addsuffix .el,$(EXTENSIONS)))
+EXT_LIBS = $(addprefix xcb-,$(addsuffix .el,$(EXTENSIONS)))
+LIBS = xcb-xproto.el $(EXT_LIBS)
all: clean $(LIBS)
-xcb-%.el: $(PROTO_PATH)/%.xml xcb-xproto.el
+xcb-%.el: $(PROTO_PATH)/%.xml
@echo -n "\n"Generating $@...
@$(EMACS_BIN) --script ./el_client.el $< > $@
+$(EXT_LIBS): xcb-xproto.el
+
xcb-composite.el: xcb-xfixes.el
xcb-damage.el: xcb-xfixes.el
-xcb-xvmc.el: xcb-xv.el
+xcb-present.el: xcb-randr.el xcb-xfixes.el xcb-sync.el
xcb-randr.el: xcb-render.el
xcb-xfixes.el: xcb-render.el xcb-shape.el
-xcb-present.el: xcb-randr.el xcb-xfixes.el xcb-sync.el
-xcb-xv.el: xcb-shm.el
xcb-xinput.el: xcb-xfixes.el
+xcb-xvmc.el: xcb-xv.el
+xcb-xv.el: xcb-shm.el
.PHONY: clean
diff --git a/el_client.el b/el_client.el
index 6ae698b..d487a27 100644
--- a/el_client.el
+++ b/el_client.el
@@ -54,6 +54,9 @@
(defvar xelb-event-alist nil "Record X events in this module.")
(make-variable-buffer-local 'xelb-event-alist)
+(defvar xelb-imports nil "Record imported libraries.")
+(make-variable-buffer-local 'xelb-imports)
+
(defvar xelb-pad-count -1 "<pad> node counter.")
(make-variable-buffer-local 'xelb-pad-count)
@@ -63,6 +66,33 @@
"Return the tag name of node NODE."
(car node))
+(defsubst xelb-node-type (node)
+ "Return the type of node NODE."
+ (let ((type-name (xelb-node-attr node 'type))
+ type)
+ (if (string-match ":" type-name)
+ ;; Defined explicitly.
+ (if (setq type
+ (intern-soft (concat "xcb:"
+ (replace-regexp-in-string "^xproto:" ""
+ type-name))))
+ type
+ (error "Undefined type :%s" type-name))
+ (if (setq type (or (intern-soft (concat "xcb:" type-name))
+ (intern-soft (concat xelb-prefix type-name))))
+ ;; Defined by the core protocol or this extension.
+ type
+ (catch 'break
+ (dolist (i xelb-imports)
+ (setq type (intern-soft (concat i type-name)))
+ (when type
+ (throw 'break type))))
+ (if type
+ ;; Defined by an imported extension.
+ type
+ ;; Not defined.
+ (error "Undefined type :%s" type-name))))))
+
(defsubst xelb-node-attr (node attr)
"Return the attribute ATTR of node NODE."
(cdr (assoc attr (cadr node))))
@@ -232,8 +262,10 @@ an `xelb-auto-padding' attribute."
(defun xelb-parse-import (node)
"Parse <import>."
- (let ((header (intern (concat "xcb-" (xelb-node-subnode node)))))
+ (let* ((name (xelb-node-subnode node))
+ (header (intern (concat "xcb-" name))))
(require header)
+ (push (concat "xcb:" name ":") xelb-imports)
`((require ',header))))
(defun xelb-parse-struct (node)
@@ -403,9 +435,7 @@ KeymapNotify event; instead, we handle this case in
`xcb:unmarshal'."
(defun xelb-parse-field (node)
"Parse <field>."
(let* ((name (intern (xelb-node-attr-escape node 'name)))
- (type (xelb-node-attr node 'type))
- (type (or (intern-soft (concat "xcb:" type)) ;extension or xproto
- (intern (concat xelb-prefix type)))))
+ (type (xelb-node-type node)))
`((,name :initarg ,(intern (concat ":" (symbol-name name))) :type ,type))))
(defun xelb-parse-fd (node)
@@ -417,9 +447,7 @@ KeymapNotify event; instead, we handle this case in
`xcb:unmarshal'."
"Parse <list>."
(let* ((name (intern (xelb-node-attr-escape node 'name)))
(name-alt (intern (concat (xelb-node-attr-escape node 'name) "~")))
- (type (xelb-node-attr node 'type))
- (type (or (intern-soft (concat "xcb:" type))
- (intern (concat xelb-prefix type))))
+ (type (xelb-node-type node))
(size (xelb-parse-expression (xelb-node-subnode node))))
`((,name :initarg ,(intern (concat ":" (symbol-name name)))
:type xcb:-ignore)
@@ -437,9 +465,7 @@ KeymapNotify event; instead, we handle this case in
`xcb:unmarshal'."
(defun xelb-parse-exprfield (node)
"Parse <exprfield>."
(let* ((name (intern (xelb-node-attr-escape node 'name)))
- (type (xelb-node-attr node 'type))
- (type (or (intern-soft (concat "xcb:" type))
- (intern (concat xelb-prefix type))))
+ (type (xelb-node-type node))
(value (xelb-parse-expression (xelb-node-subnode node))))
`((,name :type ,type)
(setf (slot-value obj ',name) ',value))))
diff --git a/xcb-composite.el b/xcb-composite.el
index 3874b3f..e0eabc6 100644
--- a/xcb-composite.el
+++ b/xcb-composite.el
@@ -81,7 +81,7 @@
(defclass xcb:composite:CreateRegionFromBorderClip
(xcb:-request)
((~opcode :initform 5 :type xcb:-u1)
- (region :initarg :region :type xcb:composite:REGION)
+ (region :initarg :region :type xcb:xfixes:REGION)
(window :initarg :window :type xcb:WINDOW)))
(defclass xcb:composite:NameWindowPixmap
diff --git a/xcb-damage.el b/xcb-damage.el
index 086d6a9..085178d 100644
--- a/xcb-damage.el
+++ b/xcb-damage.el
@@ -75,14 +75,14 @@
(xcb:-request)
((~opcode :initform 3 :type xcb:-u1)
(damage :initarg :damage :type xcb:damage:DAMAGE)
- (repair :initarg :repair :type xcb:damage:REGION)
- (parts :initarg :parts :type xcb:damage:REGION)))
+ (repair :initarg :repair :type xcb:xfixes:REGION)
+ (parts :initarg :parts :type xcb:xfixes:REGION)))
(defclass xcb:damage:Add
(xcb:-request)
((~opcode :initform 4 :type xcb:-u1)
(drawable :initarg :drawable :type xcb:DRAWABLE)
- (region :initarg :region :type xcb:damage:REGION)))
+ (region :initarg :region :type xcb:xfixes:REGION)))
(defclass xcb:damage:Notify
(xcb:-event)
diff --git a/xcb-glx.el b/xcb-glx.el
index 32ec822..524441c 100644
--- a/xcb-glx.el
+++ b/xcb-glx.el
@@ -280,7 +280,7 @@
((~opcode :initform 13 :type xcb:-u1)
(screen :initarg :screen :type xcb:CARD32)
(visual :initarg :visual :type xcb:VISUALID)
- (pixmap :initarg :pixmap :type xcb:glx:xproto:PIXMAP)
+ (pixmap :initarg :pixmap :type xcb:PIXMAP)
(glx-pixmap :initarg :glx-pixmap :type xcb:glx:PIXMAP)))
(defclass xcb:glx:GetVisualConfigs
@@ -400,7 +400,7 @@
((~opcode :initform 22 :type xcb:-u1)
(screen :initarg :screen :type xcb:CARD32)
(fbconfig :initarg :fbconfig :type xcb:glx:FBCONFIG)
- (pixmap :initarg :pixmap :type xcb:glx:xproto:PIXMAP)
+ (pixmap :initarg :pixmap :type xcb:PIXMAP)
(glx-pixmap :initarg :glx-pixmap :type xcb:glx:PIXMAP)
(num-attribs :initarg :num-attribs :type xcb:CARD32)
(attribs :initarg :attribs :type xcb:-ignore)
@@ -512,7 +512,7 @@
((~opcode :initform 31 :type xcb:-u1)
(screen :initarg :screen :type xcb:CARD32)
(fbconfig :initarg :fbconfig :type xcb:glx:FBCONFIG)
- (window :initarg :window :type xcb:glx:xproto:WINDOW)
+ (window :initarg :window :type xcb:WINDOW)
(glx-window :initarg :glx-window :type xcb:glx:WINDOW)
(num-attribs :initarg :num-attribs :type xcb:CARD32)
(attribs :initarg :attribs :type xcb:-ignore)
diff --git a/xcb-present.el b/xcb-present.el
index 8b39a70..056be3c 100644
--- a/xcb-present.el
+++ b/xcb-present.el
@@ -89,18 +89,18 @@
(window :initarg :window :type xcb:WINDOW)
(pixmap :initarg :pixmap :type xcb:PIXMAP)
(serial :initarg :serial :type xcb:CARD32)
- (valid :initarg :valid :type xcb:present:REGION)
- (update :initarg :update :type xcb:present:REGION)
+ (valid :initarg :valid :type xcb:xfixes:REGION)
+ (update :initarg :update :type xcb:xfixes:REGION)
(x-off :initarg :x-off :type xcb:INT16)
(y-off :initarg :y-off :type xcb:INT16)
- (target-crtc :initarg :target-crtc :type xcb:present:CRTC)
- (wait-fence :initarg :wait-fence :type xcb:present:FENCE)
- (idle-fence :initarg :idle-fence :type xcb:present:FENCE)
+ (target-crtc :initarg :target-crtc :type xcb:randr:CRTC)
+ (wait-fence :initarg :wait-fence :type xcb:sync:FENCE)
+ (idle-fence :initarg :idle-fence :type xcb:sync:FENCE)
(options :initarg :options :type xcb:CARD32)
(pad~0 :initform 4 :type xcb:-pad)
- (target-msc :initarg :target-msc :type xcb:present:CARD64)
- (divisor :initarg :divisor :type xcb:present:CARD64)
- (remainder :initarg :remainder :type xcb:present:CARD64)
+ (target-msc :initarg :target-msc :type xcb:CARD64)
+ (divisor :initarg :divisor :type xcb:CARD64)
+ (remainder :initarg :remainder :type xcb:CARD64)
(notifies :initarg :notifies :type xcb:-ignore)
(notifies~ :initform
'(name notifies type xcb:present:Notify size nil)
@@ -112,9 +112,9 @@
(window :initarg :window :type xcb:WINDOW)
(serial :initarg :serial :type xcb:CARD32)
(pad~0 :initform 4 :type xcb:-pad)
- (target-msc :initarg :target-msc :type xcb:present:CARD64)
- (divisor :initarg :divisor :type xcb:present:CARD64)
- (remainder :initarg :remainder :type xcb:present:CARD64)))
+ (target-msc :initarg :target-msc :type xcb:CARD64)
+ (divisor :initarg :divisor :type xcb:CARD64)
+ (remainder :initarg :remainder :type xcb:CARD64)))
(xcb:deftypealias 'xcb:present:EVENT 'xcb:-u4)
@@ -170,8 +170,8 @@
(event :initarg :event :type xcb:present:EVENT)
(window :initarg :window :type xcb:WINDOW)
(serial :initarg :serial :type xcb:CARD32)
- (ust :initarg :ust :type xcb:present:CARD64)
- (msc :initarg :msc :type xcb:present:CARD64)))
+ (ust :initarg :ust :type xcb:CARD64)
+ (msc :initarg :msc :type xcb:CARD64)))
(defclass xcb:present:IdleNotify
(xcb:-event)
@@ -183,7 +183,7 @@
(window :initarg :window :type xcb:WINDOW)
(serial :initarg :serial :type xcb:CARD32)
(pixmap :initarg :pixmap :type xcb:PIXMAP)
- (idle-fence :initarg :idle-fence :type xcb:present:FENCE)))
+ (idle-fence :initarg :idle-fence :type xcb:sync:FENCE)))
(defclass xcb:present:RedirectNotify
(xcb:-event)
@@ -197,20 +197,20 @@
(window :initarg :window :type xcb:WINDOW)
(pixmap :initarg :pixmap :type xcb:PIXMAP)
(serial :initarg :serial :type xcb:CARD32)
- (valid-region :initarg :valid-region :type xcb:present:REGION)
- (update-region :initarg :update-region :type xcb:present:REGION)
+ (valid-region :initarg :valid-region :type xcb:xfixes:REGION)
+ (update-region :initarg :update-region :type xcb:xfixes:REGION)
(valid-rect :initarg :valid-rect :type xcb:RECTANGLE)
(update-rect :initarg :update-rect :type xcb:RECTANGLE)
(x-off :initarg :x-off :type xcb:INT16)
(y-off :initarg :y-off :type xcb:INT16)
- (target-crtc :initarg :target-crtc :type xcb:present:CRTC)
- (wait-fence :initarg :wait-fence :type xcb:present:FENCE)
- (idle-fence :initarg :idle-fence :type xcb:present:FENCE)
+ (target-crtc :initarg :target-crtc :type xcb:randr:CRTC)
+ (wait-fence :initarg :wait-fence :type xcb:sync:FENCE)
+ (idle-fence :initarg :idle-fence :type xcb:sync:FENCE)
(options :initarg :options :type xcb:CARD32)
(pad~1 :initform 4 :type xcb:-pad)
- (target-msc :initarg :target-msc :type xcb:present:CARD64)
- (divisor :initarg :divisor :type xcb:present:CARD64)
- (remainder :initarg :remainder :type xcb:present:CARD64)
+ (target-msc :initarg :target-msc :type xcb:CARD64)
+ (divisor :initarg :divisor :type xcb:CARD64)
+ (remainder :initarg :remainder :type xcb:CARD64)
(notifies :initarg :notifies :type xcb:-ignore)
(notifies~ :initform
'(name notifies type xcb:present:Notify size nil)
diff --git a/xcb-randr.el b/xcb-randr.el
index 9c2a640..ccb96ee 100644
--- a/xcb-randr.el
+++ b/xcb-randr.el
@@ -592,7 +592,7 @@
(xcb:-request)
((~opcode :initform 26 :type xcb:-u1)
(crtc :initarg :crtc :type xcb:randr:CRTC)
- (transform :initarg :transform :type xcb:randr:TRANSFORM)
+ (transform :initarg :transform :type xcb:render:TRANSFORM)
(filter-len :initarg :filter-len :type xcb:CARD16)
(pad~0 :initform 2 :type xcb:-pad)
(filter-name :initarg :filter-name :type xcb:-ignore)
@@ -603,7 +603,7 @@
(pad~1 :initform 4 :type xcb:-pad-align)
(filter-params :initarg :filter-params :type xcb:-ignore)
(filter-params~ :initform
- '(name filter-params type xcb:randr:FIXED size nil)
+ '(name filter-params type xcb:render:FIXED size nil)
:type xcb:-list)))
(defclass xcb:randr:GetCrtcTransform
@@ -613,10 +613,10 @@
(defclass xcb:randr:GetCrtcTransform~reply
(xcb:-reply)
((pad~0 :initform 1 :type xcb:-pad)
- (pending-transform :initarg :pending-transform :type xcb:randr:TRANSFORM)
+ (pending-transform :initarg :pending-transform :type xcb:render:TRANSFORM)
(has-transforms :initarg :has-transforms :type xcb:BOOL)
(pad~1 :initform 3 :type xcb:-pad)
- (current-transform :initarg :current-transform :type xcb:randr:TRANSFORM)
+ (current-transform :initarg :current-transform :type xcb:render:TRANSFORM)
(pad~2 :initform 4 :type xcb:-pad)
(pending-len :initarg :pending-len :type xcb:CARD16)
(pending-nparams :initarg :pending-nparams :type xcb:CARD16)
@@ -630,7 +630,7 @@
(pad~3 :initform 4 :type xcb:-pad-align)
(pending-params :initarg :pending-params :type xcb:-ignore)
(pending-params~ :initform
- '(name pending-params type xcb:randr:FIXED size
+ '(name pending-params type xcb:render:FIXED size
(xcb:-fieldref 'pending-nparams))
:type xcb:-list)
(pad~4 :initform 4 :type xcb:-pad-align)
@@ -642,7 +642,7 @@
(pad~5 :initform 4 :type xcb:-pad-align)
(current-params :initarg :current-params :type xcb:-ignore)
(current-params~ :initform
- '(name current-params type xcb:randr:FIXED size
+ '(name current-params type xcb:render:FIXED size
(xcb:-fieldref 'current-nparams))
:type xcb:-list)))
diff --git a/xcb-types.el b/xcb-types.el
index 4950d77..35d2fba 100644
--- a/xcb-types.el
+++ b/xcb-types.el
@@ -109,6 +109,8 @@
(xcb:-pack-u2-lsb (if (>= value 0) value
(1+ (logand #xFFFF (lognot (- value)))))))
+;; Due to loss of significance of floating-point numbers, `xcb:-pack-u8' and
+;; `xcb:-pack-u8-lsb' may return approximate results.
(eval-and-compile
(if (/= 0 (lsh 1 32))
;; 64 bit
@@ -122,7 +124,45 @@
(vector (logand value #xFF)
(logand (lsh value -8) #xFF)
(logand (lsh value -16) #xFF)
- (logand (lsh value -24) #xFF))))
+ (logand (lsh value -24) #xFF)))
+ (defsubst xcb:-pack-u8 (value)
+ "8 bytes unsigned integer => byte array (MSB first)."
+ (if (integerp value)
+ (vector (logand (lsh value -56) #xFF)
+ (logand (lsh value -48) #xFF)
+ (logand (lsh value -40) #xFF)
+ (logand (lsh value -32) #xFF)
+ (logand (lsh value -24) #xFF)
+ (logand (lsh value -16) #xFF)
+ (logand (lsh value -8) #xFF)
+ (logand value #xFF))
+ (let* ((msdw (min #xFFFFFFFF (truncate value #x100000000)))
+ (lsdw (min #xFFFFFFFF
+ (truncate (- value (* msdw 4294967296.0))))))
+ (vector (logand (lsh msdw -24) #xFF) (logand (lsh msdw -16) #xFF)
+ (logand (lsh msdw -8) #xFF) (logand msdw #xFF)
+ (logand (lsh lsdw -24) #xFF) (logand (lsh lsdw -16) #xFF)
+ (logand (lsh lsdw -8) #xFF) (logand lsdw #xFF)))))
+ (defsubst xcb:-pack-u8-lsb (value)
+ "8 bytes unsigned integer => byte array (LSB first)."
+ (if (integerp value)
+ (vector (logand value #xFF)
+ (logand (lsh value -8) #xFF)
+ (logand (lsh value -16) #xFF)
+ (logand (lsh value -24) #xFF)
+ (logand (lsh value -32) #xFF)
+ (logand (lsh value -40) #xFF)
+ (logand (lsh value -48) #xFF)
+ (logand (lsh value -56) #xFF))
+ (let* ((msdw (min #xFFFFFFFF (truncate value #x100000000)))
+ (lsdw (min #xFFFFFFFF
+ (truncate (- value (* msdw 4294967296.0))))))
+ (vector (logand lsdw #xFF) (logand (lsh lsdw -8) #xFF)
+ (logand (lsh lsdw -16) #xFF) (logand (lsh lsdw -24) #xFF)
+ (logand msdw #xFF)
+ (logand (lsh msdw -8) #xFF)
+ (logand (lsh msdw -16) #xFF)
+ (logand (lsh msdw -24) #xFF))))))
;; 32 bit (30-bit actually; large numbers are represented as float type)
(defsubst xcb:-pack-u4 (value)
"4 bytes unsigned integer => byte array (MSB first, 32-bit)."
@@ -141,6 +181,44 @@
(let* ((msw (truncate value #x10000))
(lsw (truncate (- value (* msw 65536.0)))))
(vector (logand lsw #xFF) (logand (lsh lsw -8) #xFF)
+ (logand msw #xFF) (logand (lsh msw -8) #xFF)))))
+ (defsubst xcb:-pack-u8 (value)
+ "8 bytes unsigned integer => byte array (MSB first, 32-bit)."
+ (if (integerp value)
+ (vector 0 0 0 0
+ (logand (lsh value -24) #xFF) (logand (lsh value -16) #xFF)
+ (logand (lsh value -8) #xFF) (logand value #xFF))
+ (let* ((msw (min #xFFFF (truncate value #x1000000000000)))
+ (w1 (min #xFFFF
+ (truncate (setq value
+ (- value (* msw 281474976710656.0)))
+ #x100000000)))
+ (w2 (min #xFFFF
+ (truncate (setq value (- value (* w1 4294967296.0)))
+ #x10000)))
+ (lsw (min #xFFFF (truncate (- value (* w2 65536.0))))))
+ (vector (logand (lsh msw -8) #xFF) (logand msw #xFF)
+ (logand (lsh w1 -8) #xFF) (logand w1 #xFF)
+ (logand (lsh w2 -8) #xFF) (logand w2 #xFF)
+ (logand (lsh lsw -8) #xFF) (logand lsw #xFF)))))
+ (defsubst xcb:-pack-u8-lsb (value)
+ "8 bytes unsigned integer => byte array (LSB first, 32-bit)."
+ (if (integerp value)
+ (vector (logand value #xFF) (logand (lsh value -8) #xFF)
+ (logand (lsh value -16) #xFF) (logand (lsh value -24) #xFF)
+ 0 0 0 0)
+ (let* ((msw (min #xFFFF (truncate value #x1000000000000)))
+ (w1 (min #xFFFF
+ (truncate (setq value
+ (- value (* msw 281474976710656.0)))
+ #x100000000)))
+ (w2 (min #xFFFF
+ (truncate (setq value (- value (* w1 4294967296.0)))
+ #x10000)))
+ (lsw (min #xFFFF (truncate (- value (* w2 65536.0))))))
+ (vector (logand lsw #xFF) (logand (lsh lsw -8) #xFF)
+ (logand w2 #xFF) (logand (lsh w2 -8) #xFF)
+ (logand w1 #xFF) (logand (lsh w1 -8) #xFF)
(logand msw #xFF) (logand (lsh msw -8) #xFF)))))))
(defsubst xcb:-pack-i4 (value)
@@ -188,6 +266,8 @@
value
(- (logand #xFFFF (lognot (1- value)))))))
+;; Due to loss of significance of floating-point numbers, `xcb:-unpack-u8' and
+;; `xcb:-unpack-u8-lsb' may return approximate results.
(eval-and-compile
(if (/= 0 (lsh 1 32))
;; 64-bit
@@ -200,7 +280,29 @@
"Byte array => 4 bytes unsigned integer (LSB first, 64-bit)."
(logior (aref data offset) (lsh (aref data (1+ offset)) 8)
(lsh (aref data (+ offset 2)) 16)
- (lsh (aref data (+ offset 3)) 24))))
+ (lsh (aref data (+ offset 3)) 24)))
+ (defsubst xcb:-unpack-u8 (data offset)
+ "Byte array => 8 bytes unsigned integer (MSB first)."
+ (let ((msb (aref data offset)))
+ (+ (if (> msb 31) (* msb 72057594037927936.0) (lsh msb 56))
+ (logior (lsh (aref data (1+ offset)) 48)
+ (lsh (aref data (+ offset 2)) 40)
+ (lsh (aref data (+ offset 3)) 32)
+ (lsh (aref data (+ offset 4)) 24)
+ (lsh (aref data (+ offset 5)) 16)
+ (lsh (aref data (+ offset 6)) 8)
+ (aref data (+ offset 7))))))
+ (defsubst xcb:-unpack-u8-lsb (data offset)
+ "Byte array => 8 bytes unsigned integer (LSB first)."
+ (let ((msb (aref data (+ offset 7))))
+ (+ (if (> msb 31) (* msb 72057594037927936.0) (lsh msb 56))
+ (logior (lsh (aref data (+ offset 6)) 48)
+ (lsh (aref data (+ offset 5)) 40)
+ (lsh (aref data (+ offset 4)) 32)
+ (lsh (aref data (+ offset 3)) 24)
+ (lsh (aref data (+ offset 2)) 16)
+ (lsh (aref data (1+ offset)) 8)
+ (aref data offset))))))
;; 32-bit (30-bit actually; large numbers are represented as float type)
(defsubst xcb:-unpack-u4 (data offset)
"Byte array => 4 bytes unsigned integer (MSB first, 32-bit)."
@@ -215,7 +317,27 @@
(+ (if (> msb 31) (* msb 16777216.0) (lsh msb 24))
(logior (aref data offset)
(lsh (aref data (1+ offset)) 8)
- (lsh (aref data (+ offset 2)) 16)))))))
+ (lsh (aref data (+ offset 2)) 16)))))
+ (defsubst xcb:-unpack-u8 (data offset)
+ "Byte array => 8 bytes unsigned integer (MSB first, 32-bit)."
+ (+ (* (aref data offset) 72057594037927936.0)
+ (* (aref data (1+ offset)) 281474976710656.0)
+ (* (aref data (+ offset 2)) 1099511627776.0)
+ (* (aref data (+ offset 3)) 4294967296.0)
+ (* (aref data (+ offset 4)) 16777216.0)
+ (logior (lsh (aref data (+ offset 5)) 16)
+ (lsh (aref data (+ offset 6)) 8)
+ (aref data (+ offset 7)))))
+ (defsubst xcb:-unpack-u8-lsb (data offset)
+ "Byte array => 8 bytes unsigned integer (LSB first, 32-bit)."
+ (+ (* (aref data (+ offset 7)) 72057594037927936.0)
+ (* (aref data (+ offset 6)) 281474976710656.0)
+ (* (aref data (+ offset 5)) 1099511627776.0)
+ (* (aref data (+ offset 4)) 4294967296.0)
+ (* (aref data (+ offset 3)) 16777216.0)
+ (logior (lsh (aref data (+ offset 2)) 16)
+ (lsh (aref data (1+ offset)) 8)
+ (aref data offset))))))
(defsubst xcb:-unpack-i4 (data offset)
"Byte array => 4 bytes signed integer (MSB first)."
@@ -266,12 +388,14 @@
(cl-deftype xcb:-u1 () t)
(cl-deftype xcb:-u2 () t)
(cl-deftype xcb:-u4 () t)
+;; 8 B unsigned integer
+(cl-deftype xcb:-u8 () t)
;; <pad>
(cl-deftype xcb:-pad () t)
;; <pad> with align attribute
(cl-deftype xcb:-pad-align () t)
;; <fd>
-(cl-deftype xcb:-fd () t)
+(xcb:deftypealias 'xcb:-fd 'xcb:-i4)
;; <list>
(cl-deftype xcb:-list () t)
;; <switch>
@@ -288,6 +412,7 @@
(xcb:deftypealias 'xcb:CARD8 'xcb:-u1)
(xcb:deftypealias 'xcb:CARD16 'xcb:-u2)
(xcb:deftypealias 'xcb:CARD32 'xcb:-u4)
+(xcb:deftypealias 'xcb:CARD64 'xcb:-u8)
(xcb:deftypealias 'xcb:BOOL 'xcb:-u1)
;;;; Struct type
@@ -311,7 +436,7 @@ Consider let-bind it rather than change its global value."))
(catch 'break
(dolist (slot slots)
(setq type (cl--slot-descriptor-type slot))
- (unless (or (eq type 'fd) (eq type 'xcb:-ignore))
+ (unless (eq type 'xcb:-ignore)
(setq name (eieio-slot-descriptor-name slot))
(setq value (slot-value obj name))
(when (symbolp value) ;see `eieio-default-eval-maybe'
@@ -340,6 +465,8 @@ The optional POS argument indicates current byte index of
the field (used by
(if (slot-value obj '~lsb) (xcb:-pack-u4-lsb value) (xcb:-pack-u4 value)))
(`xcb:-i4
(if (slot-value obj '~lsb) (xcb:-pack-i4-lsb value) (xcb:-pack-i4 value)))
+ (`xcb:-u8
+ (if (slot-value obj '~lsb) (xcb:-pack-u8-lsb value) (xcb:-pack-u8 value)))
(`xcb:void (vector value))
(`xcb:-pad
(unless (integerp value)
@@ -409,7 +536,7 @@ The optional argument CTX is for <paramref>."
slot-name tmp type)
(dolist (slot slots)
(setq type (cl--slot-descriptor-type slot))
- (unless (or (eq type 'fd) (eq type 'xcb:-ignore))
+ (unless (eq type 'xcb:-ignore)
(setq slot-name (eieio-slot-descriptor-name slot)
tmp (xcb:-unmarshal-field obj type byte-array 0
(when (slot-boundp obj slot-name)
@@ -449,6 +576,10 @@ and the second the consumed length."
(xcb:-unpack-i4-lsb data offset)
(xcb:-unpack-i4 data offset))
4))
+ (`xcb:-u8 (list (if (slot-value obj '~lsb)
+ (xcb:-unpack-u8-lsb data offset)
+ (xcb:-unpack-u8 data offset))
+ 8))
(`xcb:void (list (aref data offset) 1))
(`xcb:-pad
(unless (integerp initform)
diff --git a/xcb-xfixes.el b/xcb-xfixes.el
index e3d6aee..26220f6 100644
--- a/xcb-xfixes.el
+++ b/xcb-xfixes.el
@@ -174,7 +174,7 @@
(xcb:-request)
((~opcode :initform 9 :type xcb:-u1)
(region :initarg :region :type xcb:xfixes:REGION)
- (picture :initarg :picture :type xcb:xfixes:PICTURE)))
+ (picture :initarg :picture :type xcb:render:PICTURE)))
(defclass xcb:xfixes:DestroyRegion
(xcb:-request)
@@ -275,7 +275,7 @@
(defclass xcb:xfixes:SetPictureClipRegion
(xcb:-request)
((~opcode :initform 22 :type xcb:-u1)
- (picture :initarg :picture :type xcb:xfixes:PICTURE)
+ (picture :initarg :picture :type xcb:render:PICTURE)
(region :initarg :region :type xcb:xfixes:REGION)
(x-origin :initarg :x-origin :type xcb:INT16)
(y-origin :initarg :y-origin :type xcb:INT16)))
diff --git a/xcb-xinput.el b/xcb-xinput.el
index ba5cfa8..578d1e2 100644
--- a/xcb-xinput.el
+++ b/xcb-xinput.el
@@ -2055,7 +2055,7 @@
(xcb:-struct)
((deviceid :initarg :deviceid :type xcb:xinput:DeviceId)
(pad~0 :initform 2 :type xcb:-pad)
- (barrier :initarg :barrier :type xcb:xinput:BARRIER)
+ (barrier :initarg :barrier :type xcb:xfixes:BARRIER)
(eventid :initarg :eventid :type xcb:CARD32)))
(defclass xcb:xinput:XIBarrierReleasePointer
@@ -2723,7 +2723,7 @@
(eventid :initarg :eventid :type xcb:CARD32)
(root :initarg :root :type xcb:WINDOW)
(event :initarg :event :type xcb:WINDOW)
- (barrier :initarg :barrier :type xcb:xinput:BARRIER)
+ (barrier :initarg :barrier :type xcb:xfixes:BARRIER)
(dtime :initarg :dtime :type xcb:CARD32)
(flags :initarg :flags :type xcb:CARD32)
(sourceid :initarg :sourceid :type xcb:xinput:DeviceId)
diff --git a/xcb-xv.el b/xcb-xv.el
index 00ce4cc..8a37682 100644
--- a/xcb-xv.el
+++ b/xcb-xv.el
@@ -470,7 +470,7 @@
(port :initarg :port :type xcb:xv:PORT)
(drawable :initarg :drawable :type xcb:DRAWABLE)
(gc :initarg :gc :type xcb:GCONTEXT)
- (shmseg :initarg :shmseg :type xcb:xv:SEG)
+ (shmseg :initarg :shmseg :type xcb:shm:SEG)
(id :initarg :id :type xcb:CARD32)
(offset :initarg :offset :type xcb:CARD32)
(src-x :initarg :src-x :type xcb:INT16)
diff --git a/xcb-xvmc.el b/xcb-xvmc.el
index 63589fa..e3471c6 100644
--- a/xcb-xvmc.el
+++ b/xcb-xvmc.el
@@ -63,7 +63,7 @@
(defclass xcb:xvmc:ListSurfaceTypes
(xcb:-request)
((~opcode :initform 1 :type xcb:-u1)
- (port-id :initarg :port-id :type xcb:xvmc:PORT)))
+ (port-id :initarg :port-id :type xcb:xv:PORT)))
(defclass xcb:xvmc:ListSurfaceTypes~reply
(xcb:-reply)
((pad~0 :initform 1 :type xcb:-pad)
@@ -79,7 +79,7 @@
(xcb:-request)
((~opcode :initform 2 :type xcb:-u1)
(context-id :initarg :context-id :type xcb:xvmc:CONTEXT)
- (port-id :initarg :port-id :type xcb:xvmc:PORT)
+ (port-id :initarg :port-id :type xcb:xv:PORT)
(surface-id :initarg :surface-id :type xcb:xvmc:SURFACE)
(width :initarg :width :type xcb:CARD16)
(height :initarg :height :type xcb:CARD16)
@@ -156,7 +156,7 @@
(defclass xcb:xvmc:ListSubpictureTypes
(xcb:-request)
((~opcode :initform 8 :type xcb:-u1)
- (port-id :initarg :port-id :type xcb:xvmc:PORT)
+ (port-id :initarg :port-id :type xcb:xv:PORT)
(surface-id :initarg :surface-id :type xcb:xvmc:SURFACE)))
(defclass xcb:xvmc:ListSubpictureTypes~reply
(xcb:-reply)
@@ -165,7 +165,7 @@
(pad~1 :initform 20 :type xcb:-pad)
(types :initarg :types :type xcb:-ignore)
(types~ :initform
- '(name types type xcb:xvmc:ImageFormatInfo size
+ '(name types type xcb:xv:ImageFormatInfo size
(xcb:-fieldref 'num))
:type xcb:-list)))
