1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 14:30:50 -08:00

Add function to trigger debugger on variable write

* lisp/emacs-lisp/debug.el (debug-on-variable-change):
(debug--variable-list):
(cancel-debug-on-variable-change): New functions.
(debugger-setup-buffer): Add watchpoint clause.
This commit is contained in:
Noam Postavsky 2015-11-21 16:03:06 -05:00
parent 459a23444e
commit cfd2b9eae1

View file

@ -306,6 +306,24 @@ That buffer should be current already."
(delete-char 1)
(insert ? )
(beginning-of-line))
;; Watchpoint triggered.
((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
(insert
"--"
(pcase details
(`(makunbound nil) (format "making %s void" symbol))
(`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
symbol buffer))
(`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
(`(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 buffer %s to %S"
symbol buffer newval))
(_ (error "unrecognized watchpoint triggered %S" (cdr args))))
": ")
(setq pos (point))
(insert ?\n))
;; Debugger entered for an error.
(`error
(insert "--Lisp error: ")
@ -850,6 +868,79 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(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-on-variable-change (variable)
"Trigger a debugger invocation when VARIABLE is changed.
When called interactively, prompt for VARIABLE in the minibuffer.
This works by calling `add-variable-watch' on VARIABLE. If you
quit from the debugger, this will abort the change (unless the
change is caused by the termination of a let-binding).
The watchpoint may be circumvented by C code that changes the
variable directly (i.e., not via `set'). Changing the value of
the variable (e.g., `setcar' on a list variable) will not trigger
watchpoint.
Use \\[cancel-debug-on-variable-change] to cancel the effect of
this command. Uninterning VARIABLE or making it an alias of
another symbol also cancels it."
(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))
;;;###autoload
(defalias 'debug-watch #'debug-on-variable-change)
(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-on-variable-change (&optional variable)
"Undo effect of \\[debug-on-variable-change] on VARIABLE.
If VARIABLE is nil, cancel debug-on-variable-change for all variables.
When called interactively, prompt for VARIABLE in the minibuffer.
To specify a nil argument interactively, exit with an empty minibuffer."
(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))))
;;;###autoload
(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
(provide 'debug)
;;; debug.el ends here