[elpa] externals/xelb eee1348 03/10: Precompute the size of <union>

[Chris Feng]

branch: externals/xelb
commit eee13488088e9eae6c0f6cf7f4b035aaa9b83f6b
Author: Chris Feng <address@hidden>
Commit: Chris Feng <address@hidden>

    Precompute the size of <union>
    
    ; Rationale: Some unions in XKB are not aligned, which makes
    ; marshaling/unmarshaling unions at runtime impossible.
    
    * el_client.el (xelb-node-size): New function for calculating node size.
    (xelb-type-size): New function for calculation the size of a type.
    (xelb-parse-union): Precompute the size of <union>.
    * xcb-types.el (xcb:-union): Add a '~size~ slot for storing the size.
    (xcb:marshal for xcb:-union, xcb:unmarshal for xcb:-union): Marshal and
    unmarshal using the precomputed size.
    
    * xcb-randr.el:
    * xcb-xkb.el:
    * xcb-xproto.el: Regenerated.
---
 el_client.el  |   35 ++++++++++++++++++++++++++++++++++-
 xcb-randr.el  |    3 ++-
 xcb-types.el  |   23 +++++++++++++----------
 xcb-xkb.el    |    6 ++++--
 xcb-xproto.el |    3 ++-
 5 files changed, 55 insertions(+), 15 deletions(-)

diff --git a/el_client.el b/el_client.el
index ee015da..06ca496 100644
--- a/el_client.el
+++ b/el_client.el
@@ -144,6 +144,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))))
@@ -287,7 +317,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>."
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-types.el b/xcb-types.el
index de4e394..421cee5 100644
--- a/xcb-types.el
+++ b/xcb-types.el
@@ -743,7 +743,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))
@@ -751,8 +751,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))
@@ -762,9 +763,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)
@@ -772,7 +776,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)
@@ -781,9 +785,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-xkb.el b/xcb-xkb.el
index d3458f8..3f315db 100644
--- a/xcb-xkb.el
+++ b/xcb-xkb.el
@@ -415,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)
@@ -862,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)
diff --git a/xcb-xproto.el b/xcb-xproto.el
index 599bc9a..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)