>From 08b87d9912c190dca57fb6c07dc97d294c6984dc Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 21 Nov 2015 16:03:06 -0500 Subject: [PATCH v4 2/5] Add function to trigger debugger on variable write * lisp/emacs-lisp/debug.el (debug-watchpoint): (debug--variable-list): (cancel-debug-watchpoint): New functions. (debugger-setup-buffer): Add watchpoint clause. --- lisp/emacs-lisp/debug.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 7d27380..48b3543 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -306,6 +306,21 @@ debugger-setup-buffer (delete-char 1) (insert ? ) (beginning-of-line)) + ;; Watchpoint triggered. + ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) + (insert + "--" + (pcase details + (`(makunbound ,_) (format "Making %s void" symbol)) + (`(let ,_) (format "let-binding %s to %S" symbol newval)) + (`(unlet ,_) (format "ending let-binding of %s" symbol)) + (`(set nil) (format "setting %s to %S" symbol newval)) + (`(set ,buffer) (format "setting %s in %s to %S" + symbol buffer newval)) + (_ (format "watchpoint triggered %S" (cdr args)))) + ": ") + (setq pos (point)) + (insert ?\n)) ;; Debugger entered for an error. (`error (insert "--Lisp error: ") @@ -850,6 +865,53 @@ debugger-list-functions (princ "Note: if you have redefined a function, then it may no longer\n") (princ "be set to debug on entry, even if it is in the list.")))))) +(defun debug--implement-debug-watch (symbol newval op where) + "Conditionally call the debugger. +This function is called when SYMBOL's value is modified." + (if (or inhibit-debug-on-entry debugger-jumping-flag) + nil + (let ((inhibit-debug-on-entry t)) + (funcall debugger 'watchpoint symbol newval op where)))) + +;;;###autoload +(defun debug-watch (variable) + (interactive + (let* ((var-at-point (variable-at-point)) + (var (and (symbolp var-at-point) var-at-point)) + (val (completing-read + (concat "Debug when setting variable" + (if var (format " (default %s): " var) ": ")) + obarray #'boundp + t nil nil (and var (symbol-name var))))) + (list (if (equal val "") var (intern val))))) + (add-variable-watcher variable #'debug--implement-debug-watch)) + + +(defun debug--variable-list () + "List of variables currently set for debug on set." + (let ((vars '())) + (mapatoms + (lambda (s) + (when (memq #'debug--implement-debug-watch + (get s 'watchers)) + (push s vars)))) + vars)) + +;;;###autoload +(defun cancel-debug-watch (&optional variable) + (interactive + (list (let ((name + (completing-read + "Cancel debug on set for variable (default all variables): " + (mapcar #'symbol-name (debug--variable-list)) nil t))) + (when name + (unless (string= name "") + (intern name)))))) + (if variable + (remove-variable-watcher variable #'debug--implement-debug-watch) + (message "Canceling debug-watch for all variables") + (mapc #'cancel-debug-watch (debug--variable-list)))) + (provide 'debug) ;;; debug.el ends here -- 2.9.3