[elpa] externals/xelb e6d814b 1/7: Print log output to an XELB-specific messages buffer

[Chris Feng]

branch: externals/xelb
commit e6d814b93a7a5469cc121eb0a64c2e300c22d352
Author: Adrián Medraño Calvo <address@hidden>
Commit: Adrián Medraño Calvo <address@hidden>

    Print log output to an XELB-specific messages buffer
    
    Using `message' to log debugging information is cumbersome, as the
    output appears constantly in the minibuffer, obscuring prompts and
    other information.  In the case of long messages, it might resize
    the minibuffer, which causes EXWM to perform additional actions
    due to the log output.
    
    This change reimplements XELB debug logging using a separate
    buffer (*XELB-DEBUG*).  Basic functionality, like scrolling when
    point is at the end of the buffer is maintained.
    
    * xcb-types.el (exwm--log): Use `xcb-debug-message' instead of
    `message'.  Prefix all messages with the name of the function.
    Make FORMAT-STRING argument optional.  Support toggling debug
    output at runtime.
    
    * xcb-debug.el: New file.
    (xcb-debug-buffer): New variable holding the buffer where debug
    messages are output to.
    (xcb-debug-message): New function printing a message to
    `xcb-debug-buffer'.
    (xcb-debug-backtrace): New function printing a backtrace.
    (xcb-debug-backtrace-on-error): New function printing a
    backtrace upon error.
    (xcb-debug--clear, xcb-debug--mark): New functions.
---
 xcb-debug.el | 113 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 xcb-types.el |  16 ++++++---
 2 files changed, 125 insertions(+), 4 deletions(-)

diff --git a/xcb-debug.el b/xcb-debug.el
new file mode 100644
index 0000000..f066960
--- /dev/null
+++ b/xcb-debug.el
@@ -0,0 +1,113 @@
+;;; xcb-debug.el --- Debugging helpers for XELB  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Adrián Medraño Calvo <address@hidden>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This module collects functions that help in debugging XELB.
+
+;;; 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-backtrace-start-frame 5
+  "From which frame to start collecting backtraces.")
+
+(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))
+    (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 ()
+  "Get the name of outermost definition at expansion time."
+  (let* ((frame (cl-find-if
+                (lambda (frame)
+                  (ignore-errors
+                    (let ((clause (car (cl-third frame))))
+                      (or (equal clause 'defalias)
+                          (equal clause 'cl-defmethod)))))
+                (reverse (xcb-debug--call-stack))))
+        (defn (cl-third frame))
+        (deftype (car defn)))
+    (cl-case deftype
+      ((defalias) (symbol-name (cl-cadadr defn)))
+      ((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)
+     (let (windows-eob)
+       ;; Note windows whose point is at EOB.
+       (dolist (w (get-buffer-window-list xcb-debug-buffer t 'nomini))
+         (when (= (window-point w) (point-max))
+           (push w windows-eob)))
+       (save-excursion
+         (goto-char (point-max))
+         ,@forms)
+       ;; Restore point.
+       (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'.
+
+The FORMAT-STRING argument follows the speficies how to print each of
+the passed OBJECTS.  See `format' for details."
+  (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)))
+      (backtrace))))
+
+(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))))
+     ,@forms))
+
+(defun xcb-debug-clear ()
+  "Clear the debug buffer."
+  (interactive)
+  (xcb-debug--with-debug-buffer
+   (erase-buffer)))
+
+(defun xcb-debug-mark ()
+  "Insert a mark in the debug buffer."
+  (interactive)
+  (xcb-debug--with-debug-buffer
+   (insert "\n")))
+
+
+
+(provide 'xcb-debug)
+
+;;; xcb-debug.el ends here
diff --git a/xcb-types.el b/xcb-types.el
index 1343dfa..601c175 100644
--- a/xcb-types.el
+++ b/xcb-types.el
@@ -51,14 +51,22 @@
 (eval-when-compile (require 'cl-lib))
 (require 'cl-generic)
 (require 'eieio)
+(require 'xcb-debug)
 
 (eval-when-compile
   (defvar xcb:debug-on nil "Non-nil to turn on debug."))
 
-(defmacro xcb:-log (format-string &rest args)
-  "Print debug info."
-  (when xcb:debug-on
-    `(message (concat "[XELB LOG] " ,format-string) ,@args)))
+(defmacro xcb:-log (&optional format-string &rest objects)
+  "Emit a message prepending the name of the function being executed.
+
+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)
+                        ,@objects)
+     nil))
 
 ;;;; Fix backward compatibility issues with Emacs 24