- Revamped enabling extensions to not depend directly on event loop c…

…ode - Default event handler is now a no-op

xcb/event-loop.scm

@@ -21,10 +21,9 @@
   (error-handlers error-handlers)
   (default-error-handler default-error-handler set-default-error-handler!))
 
-(define-public unknown-event (make-tag 'unknown-event))
 (define-public current-xcb-connection (make-parameter #f))
 (define-public (unsolicit tag) (abort tag #f))
-(define (on-unknown-event event) (notify unknown-event event))
+(define (on-unknown-event event) #f)
 
 (define (basic-error-handler cont arg) (throw 'xcb-error arg))
 
@@ -51,9 +50,14 @@
 
 (define-public unlisten-default!
   (case-lambda
-    ((xcb-conn) (set-event-default! (xcb-connection-data xcb-conn) #f))
+    ((xcb-conn)
+     (set-event-default!
+      (xcb-connection-data xcb-conn)
+      on-unknown-event))
     (()
-     (set-event-default! (xcb-connection-data (current-xcb-connection)) #f))))
+     (set-event-default!
+      (xcb-connection-data (current-xcb-connection))
+      on-unknown-event))))
 
 (define* (inner-listen! xcb-conn event-struct tag proc #:optional guard)
   (define event-dispatchers (event-handlers (xcb-connection-data xcb-conn)))

xcb/xml.scm

@@ -11,6 +11,9 @@
   #:use-module ((xcb xml core)
                 #:select (make-new-xid
                           xcb->string
+                          out-of-xids
+                          enable-big-requests!
+                          update-xid-range!
                           xcb-bytes->string
                           xcb-event->vector
                           string->xcb
@@ -35,6 +38,9 @@
                xenum-keys
                xenum-values
                xcb-bytes->string
+               out-of-xids
+               enable-big-requests!
+               update-xid-range!
                document-full
                document-brief
                xcb-connect!

xcb/xml/connection.scm

@@ -208,7 +208,7 @@
     (define event-data
       (if (not event-struct) (cons event-number bv)
           (xcb-struct-unpack-from-bytevector event-struct bv)))
-    (vector event-struct event-data))
+    (vector event-struct event-data #f))
 
   (define (read-generic-event sock)
     (define extension-opcode (recv1! sock))

xcb/xml/core.scm

@@ -26,16 +26,15 @@
   #:use-module (xcb xml ext xc_misc)
   #:use-module (xcb xml ext ge)
   #:use-module (xcb xml ext bigreq)
-  #:use-module ((xcb xml records) #:select (make-typed-value))
-  #:export (enable-extension))
+  #:use-module ((xcb xml records) #:select (make-typed-value)))
 
 (define-public (bv->xcb-string bv)
   (let ((vec (make-vector (bytevector-length bv))))
-    (for-each 
+    (for-each
      (lambda (n)
-       (vector-set! 
-        vec n 
-        (make-typed-value (integer->char (bytevector-u8-ref bv n)) char))) 
+       (vector-set!
+        vec n
+        (make-typed-value (integer->char (bytevector-u8-ref bv n)) char)))
      (iota (bytevector-length bv)))
     vec))
 
@@ -51,7 +50,7 @@
   (string-pad-right str (* (string-length str) 2) (integer->char 0)))
 
 (define-public (string->xcb str)
-  (list->vector 
+  (list->vector
    (map (lambda (ch) (make-typed-value ch char))
         (string->list str))))
 
@@ -65,26 +64,24 @@
   (let ((str-bv (string->utf16 str (native-endianness))))
     (list->vector
      (fold-right
-      (lambda (el prev)  
-	(cons (make-CHAR2B 
+      (lambda (el prev)
+	(cons (make-CHAR2B
 	       (bytevector-u8-ref str-bv (+ el 1))
-	       (bytevector-u8-ref str-bv el)) prev)) 
+	       (bytevector-u8-ref str-bv el)) prev))
       '() (iota (string-length str) 0 2)))))
 
+(define-public out-of-xids (make-prompt-tag "out-of-xids"))
+
 (define-public (next-xid-value xcb-conn)
   (let* ((setup (xcb-connection-setup xcb-conn))
          (base (xref setup 'resource_id_base))
          (mask (xref setup 'resource_id_mask))
          (inc (logand mask (- mask)))
          (last-xid (xcb-connection-last-xid xcb-conn))
-         (current-xid 
-          ;; (if (> (+ last-xid inc) mask)
-          ;;     (begin
-          ;;       (enable-xc-misc xcb-conn)
-          ;;       (if (xcb-connection-has-extension? xcb-conn 'xc_misc) 
-          ;;           (update-xid-range! xcb-conn inc)
-          ;;           (error "xml-xcb: Not more xids available!")))
-              (+ last-xid inc))) ;    )
+         (current-xid
+          (if (> (+ last-xid inc) mask)
+              (abort-to-prompt out-of-xids xcb-conn)
+              (+ last-xid inc))))
     (set-xcb-connection-last-xid! xcb-conn current-xid)
     (logior current-xid base)))
 
@@ -102,25 +99,20 @@
    (cons (number-for-event xcb-conn event-type) (bytevector->u8-list raw)))
   (list->vector (map integer->char ev)))
 
-;; (define (update-xid-range! xcb-conn inc)
-;;   (xcb-await ((range (GetXIDRange xcb-conn)))
-;;     (let ((xid-count (xref range 'count))
-;;           (xid-start (xref range 'start_id))
-;;           (setup (xcb-connection-setup xcb-conn)))
-;;       (if (and (= xid-start 0) (= xid-count 1))
-;;           (error "xml-xcb: Not more xids available!"))
-;;       (set-xcb-connection-last-xid! xcb-conn xid-start)
-;;       (xset! setup 'resource_id_mask! (* (+ xid-start (- xid-count 1)) inc))
-;;       xid-start)))
-
-;; (define-public (enable-xc-misc xcb-conn) (xcb-enable-xc_misc! xcb-conn))
-
-;; (define-public (enable-big-requests xcb-conn)
-;;   (xcb-enable-bigreq! 
-;;    xcb-conn
-;;    (lambda (reply)
-;;      (xcb-await ((enable (Enable xcb-conn)))
-;;        (set-maximum-request-length! 
-;;         xcb-conn (xref enable 'maximum_request_length))))))
+(define (update-xid-range! xcb-conn range)
+  (let* ((xid-count (xref range 'count))
+         (xid-start (xref range 'start_id))
+         (setup (xcb-connection-setup xcb-conn))
+         (mask (xref setup 'resource_id_mask))
+         (inc (mask (xref setup 'resource_id_mask))))
+    (if (and (= xid-start 0) (= xid-count 1))
+        (error "xml-xcb: Not more xids available!"))
+    (set-xcb-connection-last-xid! xcb-conn xid-start)
+    (xset! setup 'resource_id_mask! (* (+ xid-start (- xid-count 1)) inc))
+    xid-start))
+
+(define-public (enable-big-requests! xcb-conn enable)
+  (set-maximum-request-length!
+   xcb-conn (xref enable 'maximum_request_length)))
 
 (define-public (enable-generic-events xcb-conn) (xcb-enable-ge! xcb-conn))