Merge branch 'medranocalvo/xcb-logging' into externals/exwm

This commit is contained in:
Chris Feng 2018-09-09 00:00:00 +00:00
commit 05977d05ff
2 changed files with 24 additions and 128 deletions

View file

@ -31,7 +31,7 @@
(require 'xcb)
(require 'xcb-icccm)
(require 'xcb-ewmh)
(require 'exwm-debug)
(require 'xcb-debug)
(defvar exwm--connection nil "X connection.")
@ -68,21 +68,32 @@
(declare-function exwm-workspace-move-window "exwm-workspace.el"
(frame-or-index &optional id))
(defvar exwm-debug-on nil "Non-nil to turn on debug for EXWM.")
(defmacro exwm--debug (&rest forms)
(when exwm-debug-on `(progn ,@forms)))
(defmacro exwm--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."
(when exwm-debug-on
(unless format-string (setq format-string ""))
`(progn
(exwm-debug--message (concat "%s:\t" ,format-string "\n")
(exwm-debug--compile-time-function-name)
`(when exwm-debug-on
(xcb-debug:message ,(concat "%s:\t" format-string "\n")
(xcb-debug:compile-time-function-name)
,@objects)
nil)))
nil))
(defmacro exwm--debug (&rest forms)
(when exwm-debug-on `(progn ,@forms)))
(defun exwm-debug-toggle (&optional arg)
"Toggle EXWM debugging output.
When ARG is positive, turn debugging on; when negative off. When
ARG is nil, toggle debugging output."
(interactive
(list (or current-prefix-arg 'toggle)))
(setq exwm-debug-on (if (eq arg 'toggle)
(not exwm-debug-on)
(> 0 arg))))
(defsubst exwm--id->buffer (id)
"X window ID => Emacs buffer."
@ -188,6 +199,9 @@ least SECS seconds later."
(defvar exwm-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-d\C-l" #'xcb-debug:clear)
(define-key map "\C-c\C-d\C-m" #'xcb-debug:mark)
(define-key map "\C-c\C-d\C-t" #'exwm-debug-toggle)
(define-key map "\C-c\C-f" #'exwm-layout-set-fullscreen)
(define-key map "\C-c\C-h" #'exwm-floating-hide)
(define-key map "\C-c\C-k" #'exwm-input-release-keyboard)
@ -289,11 +303,6 @@ least SECS seconds later."
(/= ,i exwm-workspace-current-index)])
(number-sequence 0 (1- (exwm-workspace--count))))))))
(exwm--debug
(let ((map exwm-mode-map))
(define-key map "\C-c\C-l" #'exwm-debug-clear)
(define-key map "\C-c\C-m" #'exwm-debug-mark)))
(define-derived-mode exwm-mode nil "EXWM"
"Major mode for managing X windows.

View file

@ -1,113 +0,0 @@
;;; exwm-debug.el --- Debugging helpers for EXWM -*- lexical-binding: t -*-
;; Copyright (C) 2018 Free Software Foundation, Inc.
;; Author: Adrián Medraño Calvo <adrian@medranocalvo.com>
;; 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 EXWM.
;;; Code:
(eval-and-compile
(defvar exwm-debug-on nil "Non-nil to turn on debug for EXWM."))
(defvar exwm-debug-buffer "*EXWM-DEBUG*" "Buffer to write debug messages to.")
(defvar exwm-debug-backtrace-start-frame 5
"From which frame to start collecting backtraces.")
(defun exwm-debug--call-stack ()
"Return the current call stack frames."
(let (frames frame
;; No need to acount for our setq, while, let, ...
(index exwm-debug-backtrace-start-frame))
(while (setq frame (backtrace-frame index))
(push frame frames)
(cl-incf index))
(cl-remove-if-not 'car frames)))
(defmacro exwm-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 (exwm-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 exwm-debug--with-debug-buffer (&rest forms)
"Evaluate FORMS making sure `exwm-debug-buffer' is correctly updated."
`(with-current-buffer (get-buffer-create exwm-debug-buffer)
(let (windows-eob)
;; Note windows whose point is at EOB.
(dolist (w (get-buffer-window-list exwm-debug-buffer t t))
(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 exwm-debug--message (format-string &rest objects)
"Print a message to `exwm-debug-buffer'.
The FORMAT-STRING argument follows the speficies how to print each of
the passed OBJECTS. See `format' for details."
(exwm-debug--with-debug-buffer
(insert (apply #'format format-string objects))))
(defmacro exwm-debug--backtrace ()
"Print a backtrace to the `exwm-debug-buffer'."
'(exwm-debug--with-debug-buffer
(let ((standard-output exwm-debug-buffer))
(backtrace))))
(defmacro exwm-debug--backtrace-on-error (&rest forms)
"Evaluate FORMS. Printing a backtrace if an error is signaled."
`(let ((debug-on-error t)
(debugger (lambda (&rest _) (exwm-debug--backtrace))))
,@forms))
(defun exwm-debug-clear ()
"Clear the debug buffer."
(interactive)
(exwm-debug--with-debug-buffer
(erase-buffer)))
(defun exwm-debug-mark ()
"Insert a mark in the debug buffer."
(interactive)
(exwm-debug--with-debug-buffer
(insert " \n")))
(provide 'exwm-debug)
;;; exwm-debug.el ends here