branch: externals/xelb
commit 77586133f6175e38935d49495e73dddd3ba30991
Author: Chris Feng <chris.w.f...@gmail.com>
Commit: Chris Feng <chris.w.f...@gmail.com>
; Minor fixes for Calvo's patch set.
---
xcb-debug.el | 49 +++++++++++++++++++++++--------------------------
xcb-types.el | 22 ++++++++++++----------
xcb.el | 8 +++-----
3 files changed, 38 insertions(+), 41 deletions(-)
diff --git a/xcb-debug.el b/xcb-debug.el
index f066960..f2c1507 100644
--- a/xcb-debug.el
+++ b/xcb-debug.el
@@ -25,25 +25,22 @@
;;; Code:
-(eval-and-compile
- (defvar xcb-debug-on nil "Non-nil to turn on debug for XELB."))
+(defvar xcb-debug:buffer "*XELB-DEBUG*" "Buffer to write debug messages to.")
-(defvar xcb-debug-buffer "*XELB-DEBUG*" "Buffer to write debug messages to.")
-
-(defvar xcb-debug-backtrace-start-frame 5
+(defvar xcb-debug:backtrace-start-frame 5
"From which frame to start collecting backtraces.")
-(defun xcb-debug--call-stack ()
+(defun xcb-debug:-call-stack ()
"Return the current call stack frames."
(let (frames frame
;; No need to acount for our setq, while, let, ...
- (index xcb-debug-backtrace-start-frame))
+ (index xcb-debug:backtrace-start-frame))
(while (setq frame (backtrace-frame index))
(push frame frames)
(cl-incf index))
(cl-remove-if-not 'car frames)))
-(defmacro xcb-debug-compile-time-function-name ()
+(defmacro xcb-debug:compile-time-function-name ()
"Get the name of outermost definition at expansion time."
(let* ((frame (cl-find-if
(lambda (frame)
@@ -51,7 +48,7 @@
(let ((clause (car (cl-third frame))))
(or (equal clause 'defalias)
(equal clause 'cl-defmethod)))))
- (reverse (xcb-debug--call-stack))))
+ (reverse (xcb-debug:-call-stack))))
(defn (cl-third frame))
(deftype (car defn)))
(cl-case deftype
@@ -59,12 +56,12 @@
((cl-defmethod) (symbol-name (cadr defn)))
(t "<unknown function>"))))
-(defmacro xcb-debug--with-debug-buffer (&rest forms)
- "Evaluate FORMS making sure `xcb-debug-buffer' is correctly updated."
- `(with-current-buffer (get-buffer-create xcb-debug-buffer)
+(defmacro xcb-debug:-with-debug-buffer (&rest forms)
+ "Evaluate FORMS making sure `xcb-debug:buffer' is correctly updated."
+ `(with-current-buffer (get-buffer-create xcb-debug:buffer)
(let (windows-eob)
;; Note windows whose point is at EOB.
- (dolist (w (get-buffer-window-list xcb-debug-buffer t 'nomini))
+ (dolist (w (get-buffer-window-list xcb-debug:buffer t 'nomini))
(when (= (window-point w) (point-max))
(push w windows-eob)))
(save-excursion
@@ -74,36 +71,36 @@
(dolist (w windows-eob)
(set-window-point w (point-max))))))
-(defun xcb-debug-message (format-string &rest objects)
- "Print a message to `xcb-debug-buffer'.
+(defun xcb-debug:message (format-string &rest objects)
+ "Print a message to `xcb-debug:buffer'.
The FORMAT-STRING argument follows the speficies how to print each of
the passed OBJECTS. See `format' for details."
- (xcb-debug--with-debug-buffer
+ (xcb-debug:-with-debug-buffer
(insert (apply #'format format-string objects))))
-(defmacro xcb-debug-backtrace ()
- "Print a backtrace to the `xcb-debug-buffer'."
- '(xcb-debug--with-debug-buffer
- (let ((standard-output (get-buffer-create xcb-debug-buffer)))
+(defmacro xcb-debug:backtrace ()
+ "Print a backtrace to the `xcb-debug:buffer'."
+ '(xcb-debug:-with-debug-buffer
+ (let ((standard-output (get-buffer-create xcb-debug:buffer)))
(backtrace))))
-(defmacro xcb-debug-backtrace-on-error (&rest forms)
+(defmacro xcb-debug:backtrace-on-error (&rest forms)
"Evaluate FORMS. Printing a backtrace if an error is signaled."
`(let ((debug-on-error t)
- (debugger (lambda (&rest _) (xcb-debug--backtrace))))
+ (debugger (lambda (&rest _) (xcb-debug:backtrace))))
,@forms))
-(defun xcb-debug-clear ()
+(defun xcb-debug:clear ()
"Clear the debug buffer."
(interactive)
- (xcb-debug--with-debug-buffer
+ (xcb-debug:-with-debug-buffer
(erase-buffer)))
-(defun xcb-debug-mark ()
+(defun xcb-debug:mark ()
"Insert a mark in the debug buffer."
(interactive)
- (xcb-debug--with-debug-buffer
+ (xcb-debug:-with-debug-buffer
(insert " \n")))
diff --git a/xcb-types.el b/xcb-types.el
index b844ba6..d368f34 100644
--- a/xcb-types.el
+++ b/xcb-types.el
@@ -53,10 +53,9 @@
(require 'eieio)
(require 'xcb-debug)
-(eval-when-compile
- (defvar xcb:debug-on nil "Non-nil to turn on debug."))
+(defvar xcb:debug-on nil "Non-nil to turn on debug.")
-(defun xcb:-debug-toggle (&optional arg)
+(defun xcb:debug-toggle (&optional arg)
"Toggle XELB debugging output.
When ARG is positive, turn debugging on; when negative off. When
ARG is nil, toggle debugging output."
@@ -73,8 +72,8 @@ FORMAT-STRING is a string specifying the message to output,
as in
`format'. The OBJECTS arguments specify the substitutions."
(unless format-string (setq format-string ""))
`(when xcb:debug-on
- (xcb-debug-message ,(concat "%s:\t" format-string "\n")
- (xcb-debug-compile-time-function-name)
+ (xcb-debug:message ,(concat "%s:\t" format-string "\n")
+ (xcb-debug:compile-time-function-name)
,@objects)
nil))
@@ -470,11 +469,11 @@ Consider let-bind it rather than change its global
value."))
(defclass xcb:--struct ()
nil)
-(cl-defmethod slot-unbound ((_object xcb:--struct) _class _slot-name _fn)
- (xcb:-log "unbound-slot: %s" (list (eieio-class-name _class)
- (eieio-object-name _object)
- _slot-name _fn))
- nil)
+(cl-defmethod slot-unbound ((object xcb:--struct) class slot-name fn)
+ (unless (eq fn #'oref-default)
+ (xcb:-log "unbound-slot: %s" (list (eieio-class-name class)
+ (eieio-object-name object)
+ slot-name fn))))
(defclass xcb:-struct (xcb:--struct)
((~lsb :initarg :~lsb
@@ -797,6 +796,9 @@ This method auto-pads short results to 32 bytes."
((~size :initarg :~size :type xcb:-ignore)) ;Size of the largest member.
:documentation "Union type.")
;;
+(cl-defmethod slot-unbound ((_object xcb:-union) _class _slot-name _fn)
+ nil)
+;;
(cl-defmethod xcb:marshal ((obj xcb:-union))
"Return the byte-array representation of union OBJ.
diff --git a/xcb.el b/xcb.el
index e9f4b79..ebb3702 100644
--- a/xcb.el
+++ b/xcb.el
@@ -408,11 +408,9 @@ Concurrency is disabled as it breaks the orders of errors,
replies and events."
(setq data (aref event 1)
synthetic (aref event 2))
(dolist (listener (aref event 0))
- (with-demoted-errors "[XELB ERROR] %S"
- (if xcb:debug-on
- (xcb-debug-backtrace-on-error
- (funcall listener data synthetic))
- (funcall listener data synthetic))))))
+ (unwind-protect
+ (xcb-debug:backtrace-on-error
+ (funcall listener data synthetic))))))
(cl-decf event-lock)))))
(cl-defmethod xcb:disconnect ((obj xcb:connection))
