diff options
authorJavier Olaechea <pirata@gmail.com>2020-03-29 17:22:45 -0500
committerJavier Olaechea <pirata@gmail.com>2020-03-29 17:22:45 -0500
commit3d7439cb19b4c174fced778773b55a42b19c9dfb (patch)
parenta756b98cff241500db057576fc07fbbebe4cf64d (diff)
Change XCB-SLOT-SIZE to take an instance of the object as well.
Some fields like a list field reference other fields so we need to fetch them when computing the size. Also don't use char alias as it doesn't work.
2 files changed, 18 insertions, 6 deletions
diff --git a/src/xcb/mop.lisp b/src/xcb/mop.lisp
index 8917ed3..2013c5c 100644
--- a/src/xcb/mop.lisp
+++ b/src/xcb/mop.lisp
@@ -207,20 +207,32 @@
(defmethod xcb-type-info ((slot xcb-padding-slot-definition))
(padding-bytes slot))
-;; TODO: xcb-slot-kind
-(defgeneric xcb-slot-size (slot)
+(defmethod xcb-type-info ((slot xcb-list-slot-definition))
+ (gethash (item-type slot) *type-info*))
+(defgeneric xcb-slot-size (slot object)
(:documentation "Return the size in 8-bit bytes required to store the slot value."))
-(defmethod xcb-slot-size (slot)
+(defmethod xcb-slot-size (slot object)
"Base strategy. Fetch the type description and return its size. It
works for non-parameterized slots."
+ (declare (ignore object))
(let ((type-description (xcb-type-info slot)))
(type-size type-description)))
-(defmethod xcb-slot-size ((slot xcb-padding-slot-definition))
+(defmethod xcb-slot-size ((slot xcb-padding-slot-definition) object)
+ (declare (ignore object))
(padding-bytes slot))
+(defmethod xcb-slot-size ((slot xcb-list-slot-definition) object)
+ "Multiply the size of the ITEM-TYPE times the length of the list."
+ (let* ((type-info (xcb-type-info slot))
+ (type-size (type-size type-info))
+ (field-ref (field-ref slot))
+ (item-count (slot-value object field-ref)))
+ (* type-size item-count )))
;; First just list the types of the request
(defun compute-request-length (xcb-request)
(loop :for slot :in (sb-mop:class-slots (class-of xcb-request))
- :sum (xcb-slot-size slot)))
+ :sum (xcb-slot-size slot xcb-request)))
diff --git a/tests/lang/mop.lisp b/tests/lang/mop.lisp
index bdcafac..a4784ce 100644
--- a/tests/lang/mop.lisp
+++ b/tests/lang/mop.lisp
@@ -83,7 +83,7 @@
:reader protocol-major-version)
(pad~1 :allocation :padding :bytes 2 :field-order 3)
(name :initarg :name
- :xcb-type :list :item-type :char :field-ref name-len
+ :xcb-type :list :item-type :card8 :field-ref name-len
:field-order 4))
(:metaclass xcb/lang:xcb-metaclass))