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:
parent
459a23444e
commit
cfd2b9eae1
1 changed files with 91 additions and 0 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue