[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/xelb 7758613 6/7: ; Minor fixes for Calvo's patch set.

From: Chris Feng
Subject: [elpa] externals/xelb 7758613 6/7: ; Minor fixes for Calvo's patch set.
Date: Sun, 9 Sep 2018 06:39:56 -0400 (EDT)

branch: externals/xelb
commit 77586133f6175e38935d49495e73dddd3ba30991
Author: Chris Feng <address@hidden>
Commit: Chris Feng <address@hidden>

    ; 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:
-  (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)))
@@ -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)))
-(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))))
-(defun xcb-debug-clear ()
+(defun xcb-debug:clear ()
   "Clear the debug buffer."
-  (xcb-debug--with-debug-buffer
+  (xcb-debug:-with-debug-buffer
-(defun xcb-debug-mark ()
+(defun xcb-debug:mark ()
   "Insert a mark in the debug buffer."
-  (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)
-  (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)
@@ -470,11 +469,11 @@ Consider let-bind it rather than change its global 
 (defclass xcb:--struct ()
-(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))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]