branch: externals/xelb
commit 5a205d072ee5af2e3d3ce44463a1e903d70f82e4
Author: Steven Allen <[email protected]>
Commit: Steven Allen <[email protected]>
Use xcb:unmarshal-new and simplify
* xcb-cursor.el (xcb:cursor:-parse-file): In addition to using
`xcb:unmarshal-new', replace repeated nconc with push and nreverse and
use with-slots where appropriate.
* xcb-keysyms.el (xcb:keysyms:-on-NewKeyboardNotify):
(xcb:keysyms:-on-MapNotify): Use `xcb:unmarshal-new'.
* xcb.el (xcb:-connection-setup-filter): Use `xcb:unmarshal-new', and
combine "set" statements into `setf' blocks.
(xcb:-+reply, xcb:-request-check): Use `xcb:unmarshal-new' and avoid setq.
---
xcb-cursor.el | 36 +++++++++++-----------
xcb-keysyms.el | 6 ++--
xcb.el | 97 +++++++++++++++++++++++++---------------------------------
3 files changed, 61 insertions(+), 78 deletions(-)
diff --git a/xcb-cursor.el b/xcb-cursor.el
index f42de5d2ab..a396cef849 100644
--- a/xcb-cursor.el
+++ b/xcb-cursor.el
@@ -257,7 +257,7 @@
(insert-file-contents path) (buffer-string))))
xcb:lsb ;override global byte order
best-size chunks
- magic file-header file-header-toc chunk-header chunk)
+ magic file-header file-header-toc chunk-header)
;; Determine byte order
(setq magic (substring data 0 4))
(if (string= xcb:cursor:-file-magic-lsb magic)
@@ -265,14 +265,16 @@
(if (string= xcb:cursor:-file-magic-msb magic)
(setq xcb:lsb nil) ;MSB first
(throw 'return nil)))
- (setq file-header (make-instance 'xcb:cursor:-file-header))
- ;;
- (xcb:unmarshal file-header (substring data 0 16))
+ (setq file-header (xcb:unmarshal-new 'xcb:cursor:-file-header
+ (substring data 0 16)))
;; FIXME: checks
- (setq file-header-toc (make-instance 'xcb:cursor:-file-header-toc))
- (xcb:unmarshal file-header-toc
- (substring data 12 (+ 16 (* 12 (slot-value file-header
- 'ntoc)))))
+ (let ((ntoc (slot-value file-header 'ntoc)))
+ (setq file-header-toc
+ (xcb:unmarshal-new 'xcb:cursor:-file-header-toc
+ ;; We start 4 bytes back (16-4=12) to
+ ;; include the `ntoc' field in
+ ;; `file-header-toc'.
+ (substring data 12 (+ 16 (* 12 ntoc)))))
(with-slots (toc) file-header-toc
(let ((target (plist-get
(plist-get (slot-value obj 'extra-plist) 'cursor)
@@ -304,16 +306,14 @@
(/= version xcb:cursor:-file-chunk-image-version))
(throw 'return nil)))
;; Parse this chunk
- (setq chunk (make-instance 'xcb:cursor:-file-chunk-image))
- (xcb:unmarshal chunk (substring data (+ position 16)
- (+ position 36
- (* 4
- (slot-value chunk-header
- 'width)
- (slot-value chunk-header
- 'height)))))
- (setq chunks (nconc chunks (list chunk))))))
- (list xcb:lsb chunks)))))
+ (with-slots (width height) chunk-header
+ (push (xcb:unmarshal-new
+ 'xcb:cursor:-file-chunk-image
+ (substring data
+ (+ position 16)
+ (+ position 36 (* 4 width height))))
+ chunks))))))
+ (list xcb:lsb (nreverse chunks))))))
(cl-defmethod xcb:cursor:-load-cursor ((obj xcb:connection) file)
"Load a cursor file FILE."
diff --git a/xcb-keysyms.el b/xcb-keysyms.el
index 3335855d1b..c358ab9bb4 100644
--- a/xcb-keysyms.el
+++ b/xcb-keysyms.el
@@ -152,9 +152,8 @@ This method must be called before using any other method in
this module."
"Handle a \\='NewKeyboardNotify' event."
(let ((device-id (xcb:-get-extra-plist obj 'keysyms 'device-id))
(callback (xcb:-get-extra-plist obj 'keysyms 'callback))
- (obj1 (make-instance 'xcb:xkb:NewKeyboardNotify))
+ (obj1 (xcb:unmarshal-new 'xcb:xkb:NewKeyboardNotify data))
device updated)
- (xcb:unmarshal obj1 data)
(with-slots (deviceID oldDeviceID requestMajor requestMinor changed) obj1
(if (= 0 (logand changed xcb:xkb:NKNDetail:DeviceID))
(when (/= 0 (logand changed xcb:xkb:NKNDetail:Keycodes))
@@ -185,9 +184,8 @@ This method must be called before using any other method in
this module."
"Handle \\='MapNotify' event."
(let ((device-id (xcb:-get-extra-plist obj 'keysyms 'device-id))
(callback (xcb:-get-extra-plist obj 'keysyms 'callback))
- (obj1 (make-instance 'xcb:xkb:MapNotify))
+ (obj1 (xcb:unmarshal-new 'xcb:xkb:MapNotify data))
updated)
- (xcb:unmarshal obj1 data)
(with-slots (deviceID changed firstType nTypes firstKeySym nKeySyms) obj1
;; Ensure this event is for the current device.
(when (/= 0 (logand changed xcb:xkb:MapPart:KeyTypes))
diff --git a/xcb.el b/xcb.el
index 7399cbf649..9955308e2b 100644
--- a/xcb.el
+++ b/xcb.el
@@ -245,26 +245,20 @@
(when (>= (length cache) data-len)
(xcb:-log "Setup response: %s" cache)
(pcase (aref cache 0)
- (0
- ;; Connection failed.
- (setq obj (make-instance 'xcb:SetupFailed))
- (xcb:unmarshal obj cache)
- (setq cache (substring cache data-len))
+ (0 ;; Connection failed.
+ (setf obj (xcb:unmarshal-new 'xcb:SetupFailed cache)
+ cache (substring cache data-len))
(error "[XELB] Connection failed: %s" (slot-value obj 'reason)))
- (1
- ;; Connection established.
- (setf (slot-value connection 'message-cache) [])
- (set-process-filter process #'xcb:-connection-filter)
- (setq obj (make-instance 'xcb:Setup))
- (xcb:unmarshal obj cache)
- (setq cache (substring cache data-len))
- (setf (slot-value connection 'setup-data) obj)
- (setf (slot-value connection 'connected) t))
- (2
- ;; Authentication required.
- (setq obj (make-instance 'xcb:SetupAuthenticate))
- (xcb:unmarshal obj cache)
- (setq cache (substring cache data-len))
+ (1 ;; Connection established.
+ (setf obj (xcb:unmarshal-new 'xcb:Setup cache)
+ cache (substring cache data-len)
+ (slot-value connection 'message-cache) []
+ (process-filter process) #'xcb:-connection-filter
+ (slot-value connection 'setup-data) obj
+ (slot-value connection 'connected) t))
+ (2 ;; Authentication required.
+ (setf obj (xcb:unmarshal-new 'xcb:SetupAuthenticate cache)
+ cache (substring cache data-len))
(error "[XELB] Authentication not supported: %s"
(slot-value obj 'reason)))
(x (error "Unrecognized setup status: %d" x)))))
@@ -652,31 +646,26 @@ Otherwise no error will ever be reported."
(let* ((reply-plist (slot-value obj 'reply-plist))
(reply-data (plist-get reply-plist sequence))
(error-plist (slot-value obj 'error-plist))
- (error-data (plist-get error-plist sequence))
- class-name reply replies error errors)
- (if (symbolp reply-data)
- (setq replies nil) ;no reply
- (setq class-name (xcb:-request-class->reply-class (car reply-data)))
- (if multiple
- ;; Multiple replies
- (dolist (i (cdr reply-data))
- (setq reply (make-instance class-name))
- (xcb:unmarshal reply i)
- (setq replies (nconc replies (list reply))))
- ;; Single reply
- (setq reply-data (cadr reply-data)
- replies (make-instance class-name))
- (xcb:unmarshal replies reply-data)))
- (setq errors
- (mapcar (lambda (i)
- (setq error (make-instance
- (xcb:-error-number->class obj (car i))))
- (xcb:unmarshal error (cdr i))
- error)
- error-data))
- (cl-remf (slot-value obj 'reply-plist) sequence)
- (cl-remf (slot-value obj 'error-plist) sequence)
- (list replies errors)))
+ (error-data (plist-get error-plist sequence)))
+ (prog1 (list
+ ;; replies
+ (unless (symbolp reply-data) ;no reply
+ (let ((class-name (xcb:-request-class->reply-class
+ (car reply-data))))
+ (if multiple
+ ;; Multiple replies
+ (cl-loop
+ for reply in (cdr reply-data)
+ collect (xcb:unmarshal-new class-name reply))
+ ;; Single reply
+ (xcb:unmarshal-new class-name (cadr reply-data)))))
+ ;; errors
+ (cl-loop
+ for (errno . err) in error-data
+ for class = (xcb:-error-number->class obj errno)
+ collect (xcb:unmarshal-new class err)))
+ (cl-remf (slot-value obj 'reply-plist) sequence)
+ (cl-remf (slot-value obj 'error-plist) sequence))))
(defmacro xcb:+reply (obj sequence &optional multiple)
"Return the reply of a request of which the sequence number is SEQUENCE.
@@ -693,22 +682,18 @@ MULTIPLE value, or some replies may be lost!"
(when (plist-member (slot-value obj 'reply-plist) sequence)
(error "This method is intended for requests with no reply"))
(xcb:flush obj) ;or we may have to wait forever
- (let ((error-plist (slot-value obj 'error-plist))
- error-obj tmp)
+ (let ((error-plist (slot-value obj 'error-plist)))
(unless (plist-member error-plist sequence)
(error "This method shall be called after `xcb:+request-checked'"))
(when (> sequence (slot-value obj 'last-seen-sequence))
(xcb:aux:sync obj)) ;wait until the request is processed
- (setq error-obj
- (mapcar (lambda (i)
- (setq tmp (cdr i)
- i (make-instance
- (xcb:-error-number->class obj (car i))))
- (xcb:unmarshal i tmp)
- i)
- (plist-get error-plist sequence)))
- (cl-remf (slot-value obj 'error-plist) sequence)
- error-obj))
+ (prog1
+ (cl-loop
+ with error-data = (plist-get error-plist sequence)
+ for (errno . data) in error-data
+ for class = (xcb:-error-number->class obj errno)
+ collect (xcb:unmarshal-new class data))
+ (cl-remf (slot-value obj 'error-plist) sequence))))
(defmacro xcb:request-check (obj sequence)
"Return the error of the request of which the sequence number is SEQUENCE.
