[elpa] externals/xelb aaddcd9 18/42: Add implicit paddings after variable-length <list>

[Chris Feng]

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

    Add implicit paddings after variable-length <list>
    
    The XCB-XML description files omit paddings after <list>. This commit 
enables
    XELB to take these paddings into account when marshalling/unmarshalling.
---
 xcb-types.el |   37 ++++++++++++++++++++++++++-----------
 xcb.el       |    2 +-
 2 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/xcb-types.el b/xcb-types.el
index e1a5206..3fd06bf 100644
--- a/xcb-types.el
+++ b/xcb-types.el
@@ -340,20 +340,31 @@ The optional POS argument indicates current byte index of 
the field (used by
     (`xcb:-pad-align
      (unless (integerp value)
        (setq value (eval value `((obj . ,obj)))))
-     (make-vector (% (- 4 (% pos value)) 4) 0))
+     ;; The length slot in xcb:-request is left out
+     (let ((len (if (object-of-class-p obj xcb:-request) (+ pos 2) pos)))
+       (make-vector (% (- value (% len value)) value) 0)))
     (`xcb:-list
      (let* ((list-name (plist-get value 'name))
             (list-type (plist-get value 'type))
             (list-size (plist-get value 'size))
-            (data (slot-value obj list-name)))
+            (data (slot-value obj list-name))
+            implicit-padding)
        (unless (integerp list-size)
+         (setq implicit-padding t)
          (setq list-size (eval list-size `((obj . ,obj))))
          (unless list-size
            (setq list-size (length data)))) ;list-size can be nil
        (cl-assert (= list-size (length data)))
-       (mapconcat (lambda (i)
-                    (xcb:-marshal-field obj list-type i))
-                  data [])))
+       (let ((result (mapconcat (lambda (i)
+                                  (xcb:-marshal-field obj list-type i))
+                                data []))
+             len)
+         (if (not implicit-padding)
+             result
+           ;; The length slot in xcb:-request is left out
+           (setq len (if (object-of-class-p obj xcb:-request) (+ pos 2) pos))
+           (vconcat result
+                    (make-vector (logand (- 0 len (length result)) #x3) 0))))))
     (`xcb:-switch
      (let ((slots (eieio-class-slots (eieio-object-class obj)))
            (expression (plist-get value 'expression))
@@ -453,8 +464,10 @@ and the second the consumed length."
        (setq initform (cadr initform)))
      (let ((list-name (plist-get initform 'name))
            (list-type (plist-get initform 'type))
-           (list-size (plist-get initform 'size)))
+           (list-size (plist-get initform 'size))
+           implicit-padding)
        (unless (integerp list-size)
+         (setq implicit-padding t)
          (setq list-size (eval list-size `((obj . ,obj) (ctx . ,ctx)))))
        (cl-assert (integerp list-size))
        (pcase list-type
@@ -463,11 +476,9 @@ and the second the consumed length."
                 (decode-coding-string
                  (apply 'unibyte-string
                         (append (substring data 0 list-size) nil))
-                 'iso-latin-1))
-          (list initform list-size))
+                 'iso-latin-1)))
          (`xcb:void                     ;for further unmarshalling
-          (setf (slot-value obj list-name) (substring data 0 list-size))
-          (list initform list-size))
+          (setf (slot-value obj list-name) (substring data 0 list-size)))
          (x
           (let ((count 0)
                 result tmp)
@@ -477,7 +488,11 @@ and the second the consumed length."
               (setq data (substring data (cadr tmp)))
               (setq count (+ count (cadr tmp))))
             (setf (slot-value obj list-name) result)
-            (list initform count))))))
+            (setq list-size count))))   ;to byte length
+       (list initform (if implicit-padding
+                          ;; Assume DATA is aligned
+                          (+ list-size (% (- (length data) list-size) 4))
+                        list-size))))
     (`xcb:-switch
      (let ((slots (eieio-class-slots (eieio-object-class obj)))
            (expression (plist-get initform 'expression))
diff --git a/xcb.el b/xcb.el
index dc7d001..5732b44 100644
--- a/xcb.el
+++ b/xcb.el
@@ -441,7 +441,7 @@ classes of EVENT (since they have the same event number)."
              (+ (length msg) (length cache))) ;flush on cache full
       (xcb:flush obj)
       (setq cache []))
-    (xcb:-log "%s" request)
+    (xcb:-log "Cache request: %s" request)
     (with-slots (request-cache request-sequence) obj
       (setf request-cache (vconcat cache msg)
             request-sequence (1+ request-sequence))