aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJavier Olaechea <pirata@gmail.com>2019-04-19 01:40:33 -0500
committerJavier Olaechea <pirata@gmail.com>2019-04-19 01:52:54 -0500
commit7111f131559b1518d2d1a1e40d0ce2a94e0efa13 (patch)
tree50ec66b6779b55b54c528ad9c45c65b3b93b0c73
parent1be8496561389a7893bbd466f26d334e20d25a4d (diff)
downloadcl-xcb-intern-atom-take-2.tar.gz
InternAtom appears to work!intern-atom-take-2
There was a bug where I was diving by 4 and _then_ wrapping the result with a call to ceiling instead of calling ceiling directly. Also send the first data byte as part of the header as per spec. Finally send the 'higher end' of the length first as part of the request size. The response appears to be 32 octets at a minimum. It appears to have a field that increases in a sequence, most likely the cookie. Example code that exercises the function: (defparameter +response+ (make-array 200 :initial-element :empty :adjustable t :fill-pointer 0)) (with-xcb-connection () (send-setup-request auth-name auth-data) (read-setup-request) (send-intern-atom "WM_CLASS" t) ; WM_CLASS (send-intern-atom "WM_HINTS" t) (send-intern-atom "VISUALID" t) (setf +response+ (make-array 200 :initial-element :empty :adjustable t :fill-pointer 0)) (handler-case (loop :for byte := (read-byte *xcb-stream*) :for i :upto 100000 ;; Response => ;; #(1 0 0 1 0 0 0 0 0 0 0 67 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ;; 1 0 0 2 0 0 0 0 0 0 0 35 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ;; 1 0 0 3 0 0 0 0 0 0 0 32 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
-rw-r--r--src/xcb-proto.lisp18
-rw-r--r--tests/xcb-proto.lisp4
2 files changed, 9 insertions, 13 deletions
diff --git a/src/xcb-proto.lisp b/src/xcb-proto.lisp
index 292ffc6..35f2263 100644
--- a/src/xcb-proto.lisp
+++ b/src/xcb-proto.lisp
@@ -394,20 +394,16 @@
(defun send-intern-atom (name only-if-exists)
;; Write the opcode, 16 and the length of the request
- (let ((request-length (ceiling (/ (+ 4 1 2 2 (length name))
- 4))))
+ (let ((request-length (ceiling (+ 4 2 2 (length name))
+ 4)))
(write-byte #x10 *xcb-stream*)
- (write-byte (logand #x00FF request-length) *xcb-stream*)
- (write-byte (logand #xFF00 request-length) *xcb-stream*)
- (write-byte 0 *xcb-stream*)
(write-byte (if only-if-exists 1 0)
*xcb-stream*)
- (write-byte (logand #xFF00 (length name))
- *xcb-stream*)
- (write-byte (logand #x00FF (length name))
- *xcb-stream*)
- (write-byte 0 *xcb-stream*)
- (write-byte 0 *xcb-stream*)
+ (write-byte (logand #xFF00 request-length) *xcb-stream*)
+ (write-byte (logand #x00FF request-length) *xcb-stream*)
+ (write-byte (logand #xFF00 (length name)) *xcb-stream*)
+ (write-byte (logand #x00FF (length name)) *xcb-stream*)
+ (loop :repeat 2 :do (write-byte 0 *xcb-stream*))
(loop :for char :across name
:do (write-byte (char-code char)
*xcb-stream*))))
diff --git a/tests/xcb-proto.lisp b/tests/xcb-proto.lisp
index 01ccf27..ed29dab 100644
--- a/tests/xcb-proto.lisp
+++ b/tests/xcb-proto.lisp
@@ -35,6 +35,6 @@
(deftest intern-atom ()
(check-stream-contents (xcb::send-intern-atom "WM_HINTS" t)
- #(16 1 8 0 0 0 87 77 95 72 73 78 84 83))
+ #(16 1 0 4 0 8 0 0 87 77 95 72 73 78 84 83))
(check-stream-contents (xcb::send-intern-atom "WM_HINTS" nil)
- #(16 0 8 0 0 0 87 77 95 72 73 78 84 83)))
+ #(16 0 0 4 0 8 0 0 87 77 95 72 73 78 84 83)))