From eafd2867e15a5cfafa75868ae9bce239b9fdfa3a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 16:03:06 -0500
Subject: [PATCH v2 2/3] 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 | 63 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 0e307fa..68be115 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -304,6 +304,22 @@ (defun debugger-setup-buffer (args)
        (delete-char 1)
        (insert ? )
        (beginning-of-line))
+      ;; Watchpoint triggered.
+      ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
+       (insert
+        "--"
+        (pcase details
+          (`(unbind ,_) (format "unbinding %s" symbol))
+          (`(let ,_) (format "let-binding %s to %S" symbol newval))
+          (`(set nil) (format "setting %s to %S" symbol newval))
+          (`(set ,buffer) (format "setting %s in %s to %S"
+                                  symbol buffer newval))
+          (`(set-default ,_) (format "setting %s's default value to %S"
+                                     symbol newval))
+          (_ (format "watchpoint triggered %S" (cdr args))))
+        ": ")
+       (setq pos (point))
+       (insert ?\n))
       ;; Debugger entered for an error.
       (`error
        (insert "--Lisp error: ")
@@ -848,6 +864,53 @@ (defun 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 (op where symbol newval)
+  "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-watchpoint (debug--variable-list))))
+
 (provide 'debug)
 
 ;;; debug.el ends here
-- 
2.6.2