branch: externals/xelb
commit 5b969ed9aac902766a3d76f4ed2fd6788d49b86b
Author: Chris Feng <chris.w.f...@gmail.com>
Commit: Chris Feng <chris.w.f...@gmail.com>
Detect implicit list length
* el_client.el (xelb-request-fields): New variable holding fields in the
current request.
(xelb-parse-request): Set/Clear the variable accordingly.
(xelb-parse-fieldref): Detect implicit list length.
* el_client.el (xelb-parse-request): Remove the extra argument.
(xelb-parse-exprfield): Remove the extra quote.
---
el_client.el | 26 ++++++++++++++++++++++----
xcb-types.el | 1 -
xcb-xim.el | 12 ++++--------
xcb-xproto.el | 12 ++++++------
4 files changed, 32 insertions(+), 19 deletions(-)
diff --git a/el_client.el b/el_client.el
index 820f7c7..02d78ad 100644
--- a/el_client.el
+++ b/el_client.el
@@ -60,6 +60,9 @@
(defvar xelb-pad-count -1 "<pad> node counter.")
(make-variable-buffer-local 'xelb-pad-count)
+(defvar xelb-request-fields nil "Fields in the current request.")
+(make-variable-buffer-local 'xelb-request-fields)
+
;;;; Helper functions
(defsubst xelb-node-name (node)
@@ -324,6 +327,13 @@ The `combine-adjacent' attribute is simply ignored."
(subnodes (xelb-node-subnodes node t))
expressions
result reply-name reply-contents)
+ ;; Fill `xelb-request-fields'.
+ (setq xelb-request-fields nil)
+ (dolist (i subnodes)
+ (unless (eq (xelb-node-name i) 'reply)
+ (let ((name (xelb-node-attr i 'name)))
+ (when name
+ (push (intern (xelb-escape-name name)) xelb-request-fields)))))
(dolist (i subnodes)
(if (not (eq (xelb-node-name i) 'reply))
(progn
@@ -335,6 +345,7 @@ The `combine-adjacent' attribute is simply ignored."
(setq contents (nconc contents result))))
;; Parse <reply>
(setq xelb-pad-count -1) ;reset padding counter
+ (setq xelb-request-fields nil) ;Clear `xelb-request-fields'.
(setq reply-name
(intern (concat xelb-prefix (xelb-node-attr node 'name)
"~reply")))
@@ -342,14 +353,15 @@ The `combine-adjacent' attribute is simply ignored."
(setq reply-contents
(apply #'nconc
(mapcar #'xelb-parse-structure-content reply-contents)))))
+ (setq xelb-request-fields nil) ;Clear `xelb-request-fields'.
(delq nil contents)
(delq nil
`((defclass ,name (xcb:-request) ,contents)
;; The optional expressions
,(when expressions
- `(cl-defmethod xcb:marshal ((obj ,name) connection) nil
+ `(cl-defmethod xcb:marshal ((obj ,name)) nil
,@expressions
- (cl-call-next-method obj connection)))
+ (cl-call-next-method obj)))
;; The optional reply body
,(when reply-name
(delq nil reply-contents)
@@ -468,7 +480,7 @@ KeymapNotify event; instead, we handle this case in
`xcb:unmarshal'."
(type (xelb-node-type node))
(value (xelb-parse-expression (xelb-node-subnode node))))
`((,name :type ,type)
- (setf (slot-value obj ',name) ',value))))
+ (setf (slot-value obj ',name) ,value))))
;; The only difference between <bitcase> and <case> is whether the `condition'
;; is a list
@@ -559,7 +571,13 @@ KeymapNotify event; instead, we handle this case in
`xcb:unmarshal'."
(defun xelb-parse-fieldref (node)
"Parse <fieldref>."
- `(xcb:-fieldref ',(intern (xelb-escape-name (xelb-node-subnode node)))))
+ (let ((name (intern (xelb-escape-name (xelb-node-subnode node)))))
+ (if (or (not xelb-request-fields) ;Probably not a request.
+ (memq name xelb-request-fields)
+ (not (string-suffix-p "-len" (symbol-name name))))
+ `(xcb:-fieldref ',name)
+ `(length
+ (xcb:-fieldref ',(intern (substring (symbol-name name) 0 -4)))))))
(defun xelb-parse-paramref (node)
"Parse <paramref>."
diff --git a/xcb-types.el b/xcb-types.el
index 5bc8908..f4e41f0 100644
--- a/xcb-types.el
+++ b/xcb-types.el
@@ -41,7 +41,6 @@
;; + The current implementation of `eieio-default-eval-maybe' only `eval's a
;; certain type of forms. If this is changed in the future, we will have to
;; adapt our codes accordingly.
-;; + STRING16 and CHAR2B should always be big-endian.
;; + <paramref> for `xcb:-marshal-field'?
;; References:
diff --git a/xcb-xim.el b/xcb-xim.el
index 01229f3..db46f84 100644
--- a/xcb-xim.el
+++ b/xcb-xim.el
@@ -145,8 +145,7 @@ Consider let-bind it rather than change its global value."))
(defclass xim:STRING (xim:-struct)
((length :initarg :length :type xcb:-u2)
(string :initarg :string :type xcb:-ignore)
- (string~ :initform '(name string type xim:LPCE
- size (xcb:-fieldref 'length))
+ (string~ :initform '(name string type xim:LPCE size (xcb:-fieldref 'length))
:type xcb:-list)
(pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
:type xcb:-pad)))
@@ -418,8 +417,7 @@ Consider let-bind it rather than change its global value."))
(number :initarg :number :type xcb:CARD16)
(pad~0 :initform 2 :type xcb:-pad)
(names :initarg :names :type xcb:-ignore)
- (names~ :initform '(name names type xim:STRING
- size (xcb:-fieldref 'number))
+ (names~ :initform '(name names type xim:STRING size (xcb:-fieldref 'number))
:type xcb:-list)))
(defclass xim:auth-ng (xim:-request)
@@ -834,8 +832,7 @@ Consider let-bind it rather than change its global value."))
((flag :initform xim:commit-flag:x-lookup-chars)
(length :initarg :length :type xcb:-u2)
(string :initarg :string :type xcb:-ignore)
- (string~ :initform '(name string type xcb:BYTE
- size (xcb:-fieldref 'length))
+ (string~ :initform '(name string type xcb:BYTE size (xcb:-fieldref 'length))
:type xcb:-list)
(pad~1 :initform '(xim:PADDING (xcb:-fieldref 'length)) :type xcb:-pad)))
@@ -858,8 +855,7 @@ Consider let-bind it rather than change its global value."))
(ic-id :initarg :ic-id :type xcb:CARD16)
(length :initarg :length :type xcb:-u2)
(string :initarg :string :type xcb:-ignore)
- (string~ :initform '(name string type xcb:BYTE
- size (xcb:-fieldref 'length))
+ (string~ :initform '(name string type xcb:BYTE size (xcb:-fieldref 'length))
:type xcb:-list)
(pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
:type xcb:-pad)))
diff --git a/xcb-xproto.el b/xcb-xproto.el
index 764aed3..92e4a22 100644
--- a/xcb-xproto.el
+++ b/xcb-xproto.el
@@ -1556,15 +1556,15 @@
'(name string type xcb:CHAR2B size nil)
:type xcb:-list)))
(cl-defmethod xcb:marshal
- ((obj xcb:QueryTextExtents)
- connection)
+ ((obj xcb:QueryTextExtents))
nil
(setf
(slot-value obj 'odd-length)
- '(logand
- (xcb:-fieldref 'string-len)
- 1))
- (cl-call-next-method obj connection))
+ (logand
+ (length
+ (xcb:-fieldref 'string))
+ 1))
+ (cl-call-next-method obj))
(defclass xcb:QueryTextExtents~reply
(xcb:-reply)
((draw-direction :initarg :draw-direction :type xcb:BYTE)
