aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNoam Postavsky2016-12-02 20:39:10 -0500
committerNoam Postavsky2016-12-02 20:44:47 -0500
commit88fefc3291060f18503738aaa4e81b98f1970a55 (patch)
treef5d3a464be2d1472af9f0b754f8d22e915fc4cec
parent0fc4761ca88175c30da7209c9ab1cde788b66a76 (diff)
parent56c817837bff3ffef587a9c80d619b9fe4886159 (diff)
downloademacs-88fefc3291060f18503738aaa4e81b98f1970a55.tar.gz
emacs-88fefc3291060f18503738aaa4e81b98f1970a55.zip
; Merge: Lisp watchpoints (Bug#24923)
-rw-r--r--doc/lispref/debugging.texi31
-rw-r--r--doc/lispref/elisp.texi2
-rw-r--r--doc/lispref/variables.texi61
-rw-r--r--etc/NEWS5
-rw-r--r--lisp/emacs-lisp/debug.el91
-rw-r--r--lisp/frame.el3
-rw-r--r--lisp/help-fns.el7
-rw-r--r--src/alloc.c2
-rw-r--r--src/buffer.c82
-rw-r--r--src/bytecode.c4
-rw-r--r--src/data.c213
-rw-r--r--src/eval.c206
-rw-r--r--src/font.c6
-rw-r--r--src/lisp.h54
-rw-r--r--src/lread.c6
-rw-r--r--src/window.h1
-rw-r--r--src/xdisp.c23
-rw-r--r--test/src/data-tests.el115
18 files changed, 721 insertions, 191 deletions
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 6c0908acccb..c80b0f95b37 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -69,6 +69,7 @@ debugger recursively. @xref{Recursive Editing}.
69* Error Debugging:: Entering the debugger when an error happens. 69* Error Debugging:: Entering the debugger when an error happens.
70* Infinite Loops:: Stopping and debugging a program that doesn't exit. 70* Infinite Loops:: Stopping and debugging a program that doesn't exit.
71* Function Debugging:: Entering it when a certain function is called. 71* Function Debugging:: Entering it when a certain function is called.
72* Variable Debugging:: Entering it when a variable is modified.
72* Explicit Debug:: Entering it at a certain point in the program. 73* Explicit Debug:: Entering it at a certain point in the program.
73* Using Debugger:: What the debugger does; what you see while in it. 74* Using Debugger:: What the debugger does; what you see while in it.
74* Debugger Commands:: Commands used while in the debugger. 75* Debugger Commands:: Commands used while in the debugger.
@@ -290,6 +291,36 @@ Calling @code{cancel-debug-on-entry} does nothing to a function which is
290not currently set up to break on entry. 291not currently set up to break on entry.
291@end deffn 292@end deffn
292 293
294@node Variable Debugging
295@subsection Entering the debugger when a variable is modified
296@cindex variable write debugging
297@cindex debugging changes to variables
298
299Sometimes a problem with a function is due to a wrong setting of a
300variable. Setting up the debugger to trigger whenever the variable is
301changed is a quick way to find the origin of the setting.
302
303@deffn Command debug-on-variable-change variable
304This function arranges for the debugger to be called whenever
305@var{variable} is modified.
306
307It is implemented using the watchpoint mechanism, so it inherits the
308same characteristics and limitations: all aliases of @var{variable}
309will be watched together, only dynamic variables can be watched, and
310changes to the objects referenced by variables are not detected. For
311details, see @ref{Watching Variables}.
312@end deffn
313
314@deffn Command cancel-debug-on-variable-change &optional variable
315This function undoes the effect of @code{debug-on-variable-change} on
316@var{variable}. When called interactively, it prompts for
317@var{variable} in the minibuffer. If @var{variable} is omitted or
318@code{nil}, it cancels break-on-change for all variables. Calling
319@code{cancel-debug-on-variable-change} does nothing to a variable
320which is not currently set up to break on change.
321@end deffn
322
323
293@node Explicit Debug 324@node Explicit Debug
294@subsection Explicit Entry to the Debugger 325@subsection Explicit Entry to the Debugger
295@cindex debugger, explicit entry 326@cindex debugger, explicit entry
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 708bd9c3094..6983ab77c63 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -498,6 +498,7 @@ Variables
498* Accessing Variables:: Examining values of variables whose names 498* Accessing Variables:: Examining values of variables whose names
499 are known only at run time. 499 are known only at run time.
500* Setting Variables:: Storing new values in variables. 500* Setting Variables:: Storing new values in variables.
501* Watching Variables:: Running a function when a variable is changed.
501* Variable Scoping:: How Lisp chooses among local and global values. 502* Variable Scoping:: How Lisp chooses among local and global values.
502* Buffer-Local Variables:: Variable values in effect only in one buffer. 503* Buffer-Local Variables:: Variable values in effect only in one buffer.
503* File Local Variables:: Handling local variable lists in files. 504* File Local Variables:: Handling local variable lists in files.
@@ -642,6 +643,7 @@ The Lisp Debugger
642* Error Debugging:: Entering the debugger when an error happens. 643* Error Debugging:: Entering the debugger when an error happens.
643* Infinite Loops:: Stopping and debugging a program that doesn't exit. 644* Infinite Loops:: Stopping and debugging a program that doesn't exit.
644* Function Debugging:: Entering it when a certain function is called. 645* Function Debugging:: Entering it when a certain function is called.
646* Variable Debugging:: Entering it when a variable is modified.
645* Explicit Debug:: Entering it at a certain point in the program. 647* Explicit Debug:: Entering it at a certain point in the program.
646* Using Debugger:: What the debugger does; what you see while in it. 648* Using Debugger:: What the debugger does; what you see while in it.
647* Debugger Commands:: Commands used while in the debugger. 649* Debugger Commands:: Commands used while in the debugger.
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 4f2274f81a0..d777e4da509 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -34,6 +34,7 @@ representing the variable.
34* Accessing Variables:: Examining values of variables whose names 34* Accessing Variables:: Examining values of variables whose names
35 are known only at run time. 35 are known only at run time.
36* Setting Variables:: Storing new values in variables. 36* Setting Variables:: Storing new values in variables.
37* Watching Variables:: Running a function when a variable is changed.
37* Variable Scoping:: How Lisp chooses among local and global values. 38* Variable Scoping:: How Lisp chooses among local and global values.
38* Buffer-Local Variables:: Variable values in effect only in one buffer. 39* Buffer-Local Variables:: Variable values in effect only in one buffer.
39* File Local Variables:: Handling local variable lists in files. 40* File Local Variables:: Handling local variable lists in files.
@@ -766,6 +767,66 @@ error is signaled.
766@end example 767@end example
767@end defun 768@end defun
768 769
770@node Watching Variables
771@section Running a function when a variable is changed.
772@cindex variable watchpoints
773@cindex watchpoints for Lisp variables
774
775It is sometimes useful to take some action when a variable changes its
776value. The watchpoint facility provides the means to do so. Some
777possible uses for this feature include keeping display in sync with
778variable settings, and invoking the debugger to track down unexpected
779changes to variables (@pxref{Variable Debugging}).
780
781The following functions may be used to manipulate and query the watch
782functions for a variable.
783
784@defun add-variable-watcher symbol watch-function
785This function arranges for @var{watch-function} to be called whenever
786@var{symbol} is modified. Modifications through aliases
787(@pxref{Variable Aliases}) will have the same effect.
788
789@var{watch-function} will be called with 4 arguments: (@var{symbol}
790@var{newval} @var{operation} @var{where}).
791
792@var{symbol} is the variable being changed.
793@var{newval} is the value it will be changed to.
794@var{operation} is a symbol representing the kind of change, one of:
795`set', `let', `unlet', `makunbound', and `defvaralias'.
796@var{where} is a buffer if the buffer-local value of the variable is
797being changed, nil otherwise.
798@end defun
799
800@defun remove-variable-watch symbol watch-function
801This function removes @var{watch-function} from @var{symbol}'s list of
802watchers.
803@end defun
804
805@defun get-variable-watchers symbol
806This function returns the list of @var{symbol}'s active watcher
807functions.
808@end defun
809
810@subsection Limitations
811
812There are a couple of ways in which a variable could be modifed (or at
813least appear to be modified) without triggering a watchpoint.
814
815Since watchpoints are attached to symbols, modification to the
816objects contained within variables (e.g., by a list modification
817function @pxref{Modifying Lists}) is not caught by this mechanism.
818
819Additionally, C code can modify the value of variables directly,
820bypassing the watchpoint mechanism.
821
822A minor limitation of this feature, again because it targets symbols,
823is that only variables of dynamic scope may be watched. This poses
824little difficulty, since modifications to lexical variables can be
825discovered easily by inspecting the code within the scope of the
826variable (unlike dynamic variables, which can be modified by any code
827at all, @pxref{Variable Scoping}).
828
829
769@node Variable Scoping 830@node Variable Scoping
770@section Scoping Rules for Variable Bindings 831@section Scoping Rules for Variable Bindings
771@cindex scoping rule 832@cindex scoping rule
diff --git a/etc/NEWS b/etc/NEWS
index 0d2162c3a10..f7565b04ef8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -716,6 +716,11 @@ consistency with the new functions. For compatibility, 'sxhash'
716remains as an alias to 'sxhash-equal'. 716remains as an alias to 'sxhash-equal'.
717 717
718+++ 718+++
719** New function `add-variable-watcher' can be used to call a function
720when a symbol's value is changed. This is used to implement the new
721debugger command `debug-on-variable-change'.
722
723+++
719** Time conversion functions that accept a time zone rule argument now 724** Time conversion functions that accept a time zone rule argument now
720allow it to be OFFSET or a list (OFFSET ABBR), where the integer 725allow it to be OFFSET or a list (OFFSET ABBR), where the integer
721OFFSET is a count of seconds east of Universal Time, and the string 726OFFSET is a count of seconds east of Universal Time, and the string
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 7d273809fcd..5430b72545a 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -306,6 +306,24 @@ That buffer should be current already."
306 (delete-char 1) 306 (delete-char 1)
307 (insert ? ) 307 (insert ? )
308 (beginning-of-line)) 308 (beginning-of-line))
309 ;; Watchpoint triggered.
310 ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
311 (insert
312 "--"
313 (pcase details
314 (`(makunbound nil) (format "making %s void" symbol))
315 (`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
316 symbol buffer))
317 (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
318 (`(let ,_) (format "let-binding %s to %S" symbol newval))
319 (`(unlet ,_) (format "ending let-binding of %s" symbol))
320 (`(set nil) (format "setting %s to %S" symbol newval))
321 (`(set ,buffer) (format "setting %s in buffer %s to %S"
322 symbol buffer newval))
323 (_ (error "unrecognized watchpoint triggered %S" (cdr args))))
324 ": ")
325 (setq pos (point))
326 (insert ?\n))
309 ;; Debugger entered for an error. 327 ;; Debugger entered for an error.
310 (`error 328 (`error
311 (insert "--Lisp error: ") 329 (insert "--Lisp error: ")
@@ -850,6 +868,79 @@ To specify a nil argument interactively, exit with an empty minibuffer."
850 (princ "Note: if you have redefined a function, then it may no longer\n") 868 (princ "Note: if you have redefined a function, then it may no longer\n")
851 (princ "be set to debug on entry, even if it is in the list.")))))) 869 (princ "be set to debug on entry, even if it is in the list."))))))
852 870
871(defun debug--implement-debug-watch (symbol newval op where)
872 "Conditionally call the debugger.
873This function is called when SYMBOL's value is modified."
874 (if (or inhibit-debug-on-entry debugger-jumping-flag)
875 nil
876 (let ((inhibit-debug-on-entry t))
877 (funcall debugger 'watchpoint symbol newval op where))))
878
879;;;###autoload
880(defun debug-on-variable-change (variable)
881 "Trigger a debugger invocation when VARIABLE is changed.
882
883When called interactively, prompt for VARIABLE in the minibuffer.
884
885This works by calling `add-variable-watch' on VARIABLE. If you
886quit from the debugger, this will abort the change (unless the
887change is caused by the termination of a let-binding).
888
889The watchpoint may be circumvented by C code that changes the
890variable directly (i.e., not via `set'). Changing the value of
891the variable (e.g., `setcar' on a list variable) will not trigger
892watchpoint.
893
894Use \\[cancel-debug-on-variable-change] to cancel the effect of
895this command. Uninterning VARIABLE or making it an alias of
896another symbol also cancels it."
897 (interactive
898 (let* ((var-at-point (variable-at-point))
899 (var (and (symbolp var-at-point) var-at-point))
900 (val (completing-read
901 (concat "Debug when setting variable"
902 (if var (format " (default %s): " var) ": "))
903 obarray #'boundp
904 t nil nil (and var (symbol-name var)))))
905 (list (if (equal val "") var (intern val)))))
906 (add-variable-watcher variable #'debug--implement-debug-watch))
907
908;;;###autoload
909(defalias 'debug-watch #'debug-on-variable-change)
910
911
912(defun debug--variable-list ()
913 "List of variables currently set for debug on set."
914 (let ((vars '()))
915 (mapatoms
916 (lambda (s)
917 (when (memq #'debug--implement-debug-watch
918 (get s 'watchers))
919 (push s vars))))
920 vars))
921
922;;;###autoload
923(defun cancel-debug-on-variable-change (&optional variable)
924 "Undo effect of \\[debug-on-variable-change] on VARIABLE.
925If VARIABLE is nil, cancel debug-on-variable-change for all variables.
926When called interactively, prompt for VARIABLE in the minibuffer.
927To specify a nil argument interactively, exit with an empty minibuffer."
928 (interactive
929 (list (let ((name
930 (completing-read
931 "Cancel debug on set for variable (default all variables): "
932 (mapcar #'symbol-name (debug--variable-list)) nil t)))
933 (when name
934 (unless (string= name "")
935 (intern name))))))
936 (if variable
937 (remove-variable-watcher variable #'debug--implement-debug-watch)
938 (message "Canceling debug-watch for all variables")
939 (mapc #'cancel-debug-watch (debug--variable-list))))
940
941;;;###autoload
942(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
943
853(provide 'debug) 944(provide 'debug)
854 945
855;;; debug.el ends here 946;;; debug.el ends here
diff --git a/lisp/frame.el b/lisp/frame.el
index a5845670502..1dffc6ca753 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2249,9 +2249,8 @@ See also `toggle-frame-maximized'."
2249 'window-system-version "it does not give useful information." "24.3") 2249 'window-system-version "it does not give useful information." "24.3")
2250 2250
2251;; Variables which should trigger redisplay of the current buffer. 2251;; Variables which should trigger redisplay of the current buffer.
2252(setq redisplay--variables (make-hash-table :test 'eq :size 10))
2253(mapc (lambda (var) 2252(mapc (lambda (var)
2254 (puthash var 1 redisplay--variables)) 2253 (add-variable-watcher var (symbol-function 'set-buffer-redisplay)))
2255 '(line-spacing 2254 '(line-spacing
2256 overline-margin 2255 overline-margin
2257 line-prefix 2256 line-prefix
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 87e7d8f87bb..23dec896b81 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -918,6 +918,7 @@ it is displayed along with the global value."
918 (indirect-variable variable) 918 (indirect-variable variable)
919 (error variable))) 919 (error variable)))
920 (obsolete (get variable 'byte-obsolete-variable)) 920 (obsolete (get variable 'byte-obsolete-variable))
921 (watchpoints (get-variable-watchers variable))
921 (use (car obsolete)) 922 (use (car obsolete))
922 (safe-var (get variable 'safe-local-variable)) 923 (safe-var (get variable 'safe-local-variable))
923 (doc (or (documentation-property 924 (doc (or (documentation-property
@@ -967,6 +968,12 @@ if it is given a local binding.\n"))))
967 (t "."))) 968 (t ".")))
968 (terpri)) 969 (terpri))
969 970
971 (when watchpoints
972 (setq extra-line t)
973 (princ " Calls these functions when changed: ")
974 (princ watchpoints)
975 (terpri))
976
970 (when (member (cons variable val) 977 (when (member (cons variable val)
971 (with-current-buffer buffer 978 (with-current-buffer buffer
972 file-local-variables-alist)) 979 file-local-variables-alist))
diff --git a/src/alloc.c b/src/alloc.c
index ae32400708a..6eced7bab18 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3567,7 +3567,7 @@ init_symbol (Lisp_Object val, Lisp_Object name)
3567 set_symbol_next (val, NULL); 3567 set_symbol_next (val, NULL);
3568 p->gcmarkbit = false; 3568 p->gcmarkbit = false;
3569 p->interned = SYMBOL_UNINTERNED; 3569 p->interned = SYMBOL_UNINTERNED;
3570 p->constant = 0; 3570 p->trapped_write = SYMBOL_UNTRAPPED_WRITE;
3571 p->declared_special = false; 3571 p->declared_special = false;
3572 p->pinned = false; 3572 p->pinned = false;
3573} 3573}
diff --git a/src/buffer.c b/src/buffer.c
index aa556b75bc6..6815aa7f7ed 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -984,40 +984,54 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
984 bset_local_var_alist (b, Qnil); 984 bset_local_var_alist (b, Qnil);
985 else 985 else
986 { 986 {
987 Lisp_Object tmp, prop, last = Qnil; 987 Lisp_Object tmp, last = Qnil;
988 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp)) 988 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
989 if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) 989 {
990 { 990 Lisp_Object local_var = XCAR (XCAR (tmp));
991 /* If permanent-local, keep it. */ 991 Lisp_Object prop = Fget (local_var, Qpermanent_local);
992 last = tmp; 992
993 if (EQ (prop, Qpermanent_local_hook)) 993 if (!NILP (prop))
994 { 994 {
995 /* This is a partially permanent hook variable. 995 /* If permanent-local, keep it. */
996 Preserve only the elements that want to be preserved. */ 996 last = tmp;
997 Lisp_Object list, newlist; 997 if (EQ (prop, Qpermanent_local_hook))
998 list = XCDR (XCAR (tmp)); 998 {
999 if (!CONSP (list)) 999 /* This is a partially permanent hook variable.
1000 newlist = list; 1000 Preserve only the elements that want to be preserved. */
1001 else 1001 Lisp_Object list, newlist;
1002 for (newlist = Qnil; CONSP (list); list = XCDR (list)) 1002 list = XCDR (XCAR (tmp));
1003 { 1003 if (!CONSP (list))
1004 Lisp_Object elt = XCAR (list); 1004 newlist = list;
1005 /* Preserve element ELT if it's t, 1005 else
1006 if it is a function with a `permanent-local-hook' property, 1006 for (newlist = Qnil; CONSP (list); list = XCDR (list))
1007 or if it's not a symbol. */ 1007 {
1008 if (! SYMBOLP (elt) 1008 Lisp_Object elt = XCAR (list);
1009 || EQ (elt, Qt) 1009 /* Preserve element ELT if it's t,
1010 || !NILP (Fget (elt, Qpermanent_local_hook))) 1010 if it is a function with a `permanent-local-hook' property,
1011 newlist = Fcons (elt, newlist); 1011 or if it's not a symbol. */
1012 } 1012 if (! SYMBOLP (elt)
1013 XSETCDR (XCAR (tmp), Fnreverse (newlist)); 1013 || EQ (elt, Qt)
1014 } 1014 || !NILP (Fget (elt, Qpermanent_local_hook)))
1015 } 1015 newlist = Fcons (elt, newlist);
1016 /* Delete this local variable. */ 1016 }
1017 else if (NILP (last)) 1017 newlist = Fnreverse (newlist);
1018 bset_local_var_alist (b, XCDR (tmp)); 1018 if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE)
1019 else 1019 notify_variable_watchers (local_var, newlist,
1020 XSETCDR (last, XCDR (tmp)); 1020 Qmakunbound, Fcurrent_buffer ());
1021 XSETCDR (XCAR (tmp), newlist);
1022 continue; /* Don't do variable write trapping twice. */
1023 }
1024 }
1025 /* Delete this local variable. */
1026 else if (NILP (last))
1027 bset_local_var_alist (b, XCDR (tmp));
1028 else
1029 XSETCDR (last, XCDR (tmp));
1030
1031 if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE)
1032 notify_variable_watchers (local_var, Qnil,
1033 Qmakunbound, Fcurrent_buffer ());
1034 }
1021 } 1035 }
1022 1036
1023 for (i = 0; i < last_per_buffer_idx; ++i) 1037 for (i = 0; i < last_per_buffer_idx; ++i)
@@ -5541,7 +5555,7 @@ file I/O and the behavior of various editing commands.
5541This variable is buffer-local but you cannot set it directly; 5555This variable is buffer-local but you cannot set it directly;
5542use the function `set-buffer-multibyte' to change a buffer's representation. 5556use the function `set-buffer-multibyte' to change a buffer's representation.
5543See also Info node `(elisp)Text Representations'. */); 5557See also Info node `(elisp)Text Representations'. */);
5544 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1; 5558 make_symbol_constant (intern_c_string ("enable-multibyte-characters"));
5545 5559
5546 DEFVAR_PER_BUFFER ("buffer-file-coding-system", 5560 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5547 &BVAR (current_buffer, buffer_file_coding_system), Qnil, 5561 &BVAR (current_buffer, buffer_file_coding_system), Qnil,
diff --git a/src/bytecode.c b/src/bytecode.c
index be39a81c5e9..868c0148d30 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -569,10 +569,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
569 if (SYMBOLP (sym) 569 if (SYMBOLP (sym)
570 && !EQ (val, Qunbound) 570 && !EQ (val, Qunbound)
571 && !XSYMBOL (sym)->redirect 571 && !XSYMBOL (sym)->redirect
572 && !SYMBOL_CONSTANT_P (sym)) 572 && !SYMBOL_TRAPPED_WRITE_P (sym))
573 SET_SYMBOL_VAL (XSYMBOL (sym), val); 573 SET_SYMBOL_VAL (XSYMBOL (sym), val);
574 else 574 else
575 set_internal (sym, val, Qnil, false); 575 set_internal (sym, val, Qnil, SET_INTERNAL_SET);
576 } 576 }
577 NEXT; 577 NEXT;
578 578
diff --git a/src/data.c b/src/data.c
index 61b5da8b5b6..eee2a52a37a 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1225,7 +1225,7 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
1225 doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */) 1225 doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */)
1226 (register Lisp_Object symbol, Lisp_Object newval) 1226 (register Lisp_Object symbol, Lisp_Object newval)
1227{ 1227{
1228 set_internal (symbol, newval, Qnil, 0); 1228 set_internal (symbol, newval, Qnil, SET_INTERNAL_SET);
1229 return newval; 1229 return newval;
1230} 1230}
1231 1231
@@ -1233,13 +1233,14 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
1233 If buffer/frame-locality is an issue, WHERE specifies which context to use. 1233 If buffer/frame-locality is an issue, WHERE specifies which context to use.
1234 (nil stands for the current buffer/frame). 1234 (nil stands for the current buffer/frame).
1235 1235
1236 If BINDFLAG is false, then if this symbol is supposed to become 1236 If BINDFLAG is SET_INTERNAL_SET, then if this symbol is supposed to
1237 local in every buffer where it is set, then we make it local. 1237 become local in every buffer where it is set, then we make it
1238 If BINDFLAG is true, we don't do that. */ 1238 local. If BINDFLAG is SET_INTERNAL_BIND or SET_INTERNAL_UNBIND, we
1239 don't do that. */
1239 1240
1240void 1241void
1241set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, 1242set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
1242 bool bindflag) 1243 enum Set_Internal_Bind bindflag)
1243{ 1244{
1244 bool voide = EQ (newval, Qunbound); 1245 bool voide = EQ (newval, Qunbound);
1245 struct Lisp_Symbol *sym; 1246 struct Lisp_Symbol *sym;
@@ -1250,18 +1251,29 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
1250 return; */ 1251 return; */
1251 1252
1252 CHECK_SYMBOL (symbol); 1253 CHECK_SYMBOL (symbol);
1253 if (SYMBOL_CONSTANT_P (symbol)) 1254 sym = XSYMBOL (symbol);
1255 switch (sym->trapped_write)
1254 { 1256 {
1257 case SYMBOL_NOWRITE:
1255 if (NILP (Fkeywordp (symbol)) 1258 if (NILP (Fkeywordp (symbol))
1256 || !EQ (newval, Fsymbol_value (symbol))) 1259 || !EQ (newval, Fsymbol_value (symbol)))
1257 xsignal1 (Qsetting_constant, symbol); 1260 xsignal1 (Qsetting_constant, symbol);
1258 else 1261 else
1259 /* Allow setting keywords to their own value. */ 1262 /* Allow setting keywords to their own value. */
1260 return; 1263 return;
1261 } 1264
1265 case SYMBOL_TRAPPED_WRITE:
1266 notify_variable_watchers (symbol, voide? Qnil : newval,
1267 (bindflag == SET_INTERNAL_BIND? Qlet :
1268 bindflag == SET_INTERNAL_UNBIND? Qunlet :
1269 voide? Qmakunbound : Qset),
1270 where);
1271 /* FALLTHROUGH! */
1272 case SYMBOL_UNTRAPPED_WRITE:
1273 break;
1262 1274
1263 maybe_set_redisplay (symbol); 1275 default: emacs_abort ();
1264 sym = XSYMBOL (symbol); 1276 }
1265 1277
1266 start: 1278 start:
1267 switch (sym->redirect) 1279 switch (sym->redirect)
@@ -1385,6 +1397,130 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
1385 } 1397 }
1386 return; 1398 return;
1387} 1399}
1400
1401static void
1402set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap)
1403{
1404 struct Lisp_Symbol* sym = XSYMBOL (symbol);
1405 if (sym->trapped_write == SYMBOL_NOWRITE)
1406 xsignal1 (Qtrapping_constant, symbol);
1407 else if (sym->redirect == SYMBOL_LOCALIZED
1408 && SYMBOL_BLV (sym)->frame_local)
1409 xsignal1 (Qtrapping_frame_local, symbol);
1410 sym->trapped_write = trap;
1411}
1412
1413static void
1414restore_symbol_trapped_write (Lisp_Object symbol)
1415{
1416 set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
1417}
1418
1419static void
1420harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable)
1421{
1422 if (!EQ (base_variable, alias)
1423 && EQ (base_variable, Findirect_variable (alias)))
1424 set_symbol_trapped_write
1425 (alias, XSYMBOL (base_variable)->trapped_write);
1426}
1427
1428DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
1429 2, 2, 0,
1430 doc: /* Cause WATCH-FUNCTION to be called when SYMBOL is set.
1431
1432It will be called with 4 arguments: (SYMBOL NEWVAL OPERATION WHERE).
1433SYMBOL is the variable being changed.
1434NEWVAL is the value it will be changed to.
1435OPERATION is a symbol representing the kind of change, one of: `set',
1436`let', `unlet', `makunbound', and `defvaralias'.
1437WHERE is a buffer if the buffer-local value of the variable being
1438changed, nil otherwise.
1439
1440All writes to aliases of SYMBOL will call WATCH-FUNCTION too. */)
1441 (Lisp_Object symbol, Lisp_Object watch_function)
1442{
1443 symbol = Findirect_variable (symbol);
1444 set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
1445 map_obarray (Vobarray, harmonize_variable_watchers, symbol);
1446
1447 Lisp_Object watchers = Fget (symbol, Qwatchers);
1448 Lisp_Object member = Fmember (watch_function, watchers);
1449 if (NILP (member))
1450 Fput (symbol, Qwatchers, Fcons (watch_function, watchers));
1451 return Qnil;
1452}
1453
1454DEFUN ("remove-variable-watcher", Fremove_variable_watcher, Sremove_variable_watcher,
1455 2, 2, 0,
1456 doc: /* Undo the effect of `add-variable-watcher'.
1457Remove WATCH-FUNCTION from the list of functions to be called when
1458SYMBOL (or its aliases) are set. */)
1459 (Lisp_Object symbol, Lisp_Object watch_function)
1460{
1461 symbol = Findirect_variable (symbol);
1462 Lisp_Object watchers = Fget (symbol, Qwatchers);
1463 watchers = Fdelete (watch_function, watchers);
1464 if (NILP (watchers))
1465 {
1466 set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
1467 map_obarray (Vobarray, harmonize_variable_watchers, symbol);
1468 }
1469 Fput (symbol, Qwatchers, watchers);
1470 return Qnil;
1471}
1472
1473DEFUN ("get-variable-watchers", Fget_variable_watchers, Sget_variable_watchers,
1474 1, 1, 0,
1475 doc: /* Return a list of SYMBOL's active watchers. */)
1476 (Lisp_Object symbol)
1477{
1478 return (SYMBOL_TRAPPED_WRITE_P (symbol) == SYMBOL_TRAPPED_WRITE)
1479 ? Fget (Findirect_variable (symbol), Qwatchers)
1480 : Qnil;
1481}
1482
1483void
1484notify_variable_watchers (Lisp_Object symbol,
1485 Lisp_Object newval,
1486 Lisp_Object operation,
1487 Lisp_Object where)
1488{
1489 symbol = Findirect_variable (symbol);
1490
1491 ptrdiff_t count = SPECPDL_INDEX ();
1492 record_unwind_protect (restore_symbol_trapped_write, symbol);
1493 /* Avoid recursion. */
1494 set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
1495
1496 if (NILP (where)
1497 && !EQ (operation, Qset_default) && !EQ (operation, Qmakunbound)
1498 && !NILP (Flocal_variable_if_set_p (symbol, Fcurrent_buffer ())))
1499 {
1500 XSETBUFFER (where, current_buffer);
1501 }
1502
1503 if (EQ (operation, Qset_default))
1504 operation = Qset;
1505
1506 for (Lisp_Object watchers = Fget (symbol, Qwatchers);
1507 CONSP (watchers);
1508 watchers = XCDR (watchers))
1509 {
1510 Lisp_Object watcher = XCAR (watchers);
1511 /* Call subr directly to avoid gc. */
1512 if (SUBRP (watcher))
1513 {
1514 Lisp_Object args[] = { symbol, newval, operation, where };
1515 funcall_subr (XSUBR (watcher), ARRAYELTS (args), args);
1516 }
1517 else
1518 CALLN (Ffuncall, watcher, symbol, newval, operation, where);
1519 }
1520
1521 unbind_to (count, Qnil);
1522}
1523
1388 1524
1389/* Access or set a buffer-local symbol's default value. */ 1525/* Access or set a buffer-local symbol's default value. */
1390 1526
@@ -1471,16 +1607,27 @@ for this variable. */)
1471 struct Lisp_Symbol *sym; 1607 struct Lisp_Symbol *sym;
1472 1608
1473 CHECK_SYMBOL (symbol); 1609 CHECK_SYMBOL (symbol);
1474 if (SYMBOL_CONSTANT_P (symbol)) 1610 sym = XSYMBOL (symbol);
1611 switch (sym->trapped_write)
1475 { 1612 {
1613 case SYMBOL_NOWRITE:
1476 if (NILP (Fkeywordp (symbol)) 1614 if (NILP (Fkeywordp (symbol))
1477 || !EQ (value, Fdefault_value (symbol))) 1615 || !EQ (value, Fsymbol_value (symbol)))
1478 xsignal1 (Qsetting_constant, symbol); 1616 xsignal1 (Qsetting_constant, symbol);
1479 else 1617 else
1480 /* Allow setting keywords to their own value. */ 1618 /* Allow setting keywords to their own value. */
1481 return value; 1619 return value;
1620
1621 case SYMBOL_TRAPPED_WRITE:
1622 /* Don't notify here if we're going to call Fset anyway. */
1623 if (sym->redirect != SYMBOL_PLAINVAL)
1624 notify_variable_watchers (symbol, value, Qset_default, Qnil);
1625 /* FALLTHROUGH! */
1626 case SYMBOL_UNTRAPPED_WRITE:
1627 break;
1628
1629 default: emacs_abort ();
1482 } 1630 }
1483 sym = XSYMBOL (symbol);
1484 1631
1485 start: 1632 start:
1486 switch (sym->redirect) 1633 switch (sym->redirect)
@@ -1651,7 +1798,7 @@ The function `default-value' gets the default value and `set-default' sets it.
1651 default: emacs_abort (); 1798 default: emacs_abort ();
1652 } 1799 }
1653 1800
1654 if (sym->constant) 1801 if (SYMBOL_CONSTANT_P (variable))
1655 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); 1802 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
1656 1803
1657 if (!blv) 1804 if (!blv)
@@ -1726,7 +1873,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
1726 default: emacs_abort (); 1873 default: emacs_abort ();
1727 } 1874 }
1728 1875
1729 if (sym->constant) 1876 if (sym->trapped_write == SYMBOL_NOWRITE)
1730 error ("Symbol %s may not be buffer-local", 1877 error ("Symbol %s may not be buffer-local",
1731 SDATA (SYMBOL_NAME (variable))); 1878 SDATA (SYMBOL_NAME (variable)));
1732 1879
@@ -1838,6 +1985,9 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1838 default: emacs_abort (); 1985 default: emacs_abort ();
1839 } 1986 }
1840 1987
1988 if (sym->trapped_write == SYMBOL_TRAPPED_WRITE)
1989 notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ());
1990
1841 /* Get rid of this buffer's alist element, if any. */ 1991 /* Get rid of this buffer's alist element, if any. */
1842 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ 1992 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
1843 tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); 1993 tem = Fassq (variable, BVAR (current_buffer, local_var_alist));
@@ -1920,7 +2070,7 @@ frame-local bindings). */)
1920 default: emacs_abort (); 2070 default: emacs_abort ();
1921 } 2071 }
1922 2072
1923 if (sym->constant) 2073 if (SYMBOL_TRAPPED_WRITE_P (variable))
1924 error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); 2074 error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
1925 2075
1926 blv = make_blv (sym, forwarded, valcontents); 2076 blv = make_blv (sym, forwarded, valcontents);
@@ -3465,6 +3615,8 @@ syms_of_data (void)
3465 DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection"); 3615 DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection");
3466 DEFSYM (Qvoid_variable, "void-variable"); 3616 DEFSYM (Qvoid_variable, "void-variable");
3467 DEFSYM (Qsetting_constant, "setting-constant"); 3617 DEFSYM (Qsetting_constant, "setting-constant");
3618 DEFSYM (Qtrapping_constant, "trapping-constant");
3619 DEFSYM (Qtrapping_frame_local, "trapping-frame-local");
3468 DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax"); 3620 DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax");
3469 3621
3470 DEFSYM (Qinvalid_function, "invalid-function"); 3622 DEFSYM (Qinvalid_function, "invalid-function");
@@ -3543,6 +3695,10 @@ syms_of_data (void)
3543 PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void"); 3695 PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void");
3544 PUT_ERROR (Qsetting_constant, error_tail, 3696 PUT_ERROR (Qsetting_constant, error_tail,
3545 "Attempt to set a constant symbol"); 3697 "Attempt to set a constant symbol");
3698 PUT_ERROR (Qtrapping_constant, error_tail,
3699 "Attempt to trap writes to a constant symbol");
3700 PUT_ERROR (Qtrapping_frame_local, error_tail,
3701 "Attempt to trap writes to a frame local variable");
3546 PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax"); 3702 PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax");
3547 PUT_ERROR (Qinvalid_function, error_tail, "Invalid function"); 3703 PUT_ERROR (Qinvalid_function, error_tail, "Invalid function");
3548 PUT_ERROR (Qwrong_number_of_arguments, error_tail, 3704 PUT_ERROR (Qwrong_number_of_arguments, error_tail,
@@ -3721,10 +3877,19 @@ syms_of_data (void)
3721 DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, 3877 DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
3722 doc: /* The largest value that is representable in a Lisp integer. */); 3878 doc: /* The largest value that is representable in a Lisp integer. */);
3723 Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM); 3879 Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
3724 XSYMBOL (intern_c_string ("most-positive-fixnum"))->constant = 1; 3880 make_symbol_constant (intern_c_string ("most-positive-fixnum"));
3725 3881
3726 DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum, 3882 DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum,
3727 doc: /* The smallest value that is representable in a Lisp integer. */); 3883 doc: /* The smallest value that is representable in a Lisp integer. */);
3728 Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); 3884 Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
3729 XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; 3885 make_symbol_constant (intern_c_string ("most-negative-fixnum"));
3886
3887 DEFSYM (Qwatchers, "watchers");
3888 DEFSYM (Qmakunbound, "makunbound");
3889 DEFSYM (Qunlet, "unlet");
3890 DEFSYM (Qset, "set");
3891 DEFSYM (Qset_default, "set-default");
3892 defsubr (&Sadd_variable_watcher);
3893 defsubr (&Sremove_variable_watcher);
3894 defsubr (&Sget_variable_watchers);
3730} 3895}
diff --git a/src/eval.c b/src/eval.c
index bbc1518be54..724f0018a58 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -593,12 +593,12 @@ The return value is BASE-VARIABLE. */)
593 CHECK_SYMBOL (new_alias); 593 CHECK_SYMBOL (new_alias);
594 CHECK_SYMBOL (base_variable); 594 CHECK_SYMBOL (base_variable);
595 595
596 sym = XSYMBOL (new_alias); 596 if (SYMBOL_CONSTANT_P (new_alias))
597 597 /* Making it an alias effectively changes its value. */
598 if (sym->constant)
599 /* Not sure why, but why not? */
600 error ("Cannot make a constant an alias"); 598 error ("Cannot make a constant an alias");
601 599
600 sym = XSYMBOL (new_alias);
601
602 switch (sym->redirect) 602 switch (sym->redirect)
603 { 603 {
604 case SYMBOL_FORWARDED: 604 case SYMBOL_FORWARDED:
@@ -617,8 +617,8 @@ The return value is BASE-VARIABLE. */)
617 so that old-code that affects n_a before the aliasing is setup 617 so that old-code that affects n_a before the aliasing is setup
618 still works. */ 618 still works. */
619 if (NILP (Fboundp (base_variable))) 619 if (NILP (Fboundp (base_variable)))
620 set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1); 620 set_internal (base_variable, find_symbol_value (new_alias),
621 621 Qnil, SET_INTERNAL_BIND);
622 { 622 {
623 union specbinding *p; 623 union specbinding *p;
624 624
@@ -628,11 +628,14 @@ The return value is BASE-VARIABLE. */)
628 error ("Don't know how to make a let-bound variable an alias"); 628 error ("Don't know how to make a let-bound variable an alias");
629 } 629 }
630 630
631 if (sym->trapped_write == SYMBOL_TRAPPED_WRITE)
632 notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil);
633
631 sym->declared_special = 1; 634 sym->declared_special = 1;
632 XSYMBOL (base_variable)->declared_special = 1; 635 XSYMBOL (base_variable)->declared_special = 1;
633 sym->redirect = SYMBOL_VARALIAS; 636 sym->redirect = SYMBOL_VARALIAS;
634 SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); 637 SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
635 sym->constant = SYMBOL_CONSTANT_P (base_variable); 638 sym->trapped_write = XSYMBOL (base_variable)->trapped_write;
636 LOADHIST_ATTACH (new_alias); 639 LOADHIST_ATTACH (new_alias);
637 /* Even if docstring is nil: remove old docstring. */ 640 /* Even if docstring is nil: remove old docstring. */
638 Fput (new_alias, Qvariable_documentation, docstring); 641 Fput (new_alias, Qvariable_documentation, docstring);
@@ -2645,9 +2648,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2645 Lisp_Object fun, original_fun; 2648 Lisp_Object fun, original_fun;
2646 Lisp_Object funcar; 2649 Lisp_Object funcar;
2647 ptrdiff_t numargs = nargs - 1; 2650 ptrdiff_t numargs = nargs - 1;
2648 Lisp_Object lisp_numargs;
2649 Lisp_Object val; 2651 Lisp_Object val;
2650 Lisp_Object *internal_args;
2651 ptrdiff_t count; 2652 ptrdiff_t count;
2652 2653
2653 QUIT; 2654 QUIT;
@@ -2680,86 +2681,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2680 fun = indirect_function (fun); 2681 fun = indirect_function (fun);
2681 2682
2682 if (SUBRP (fun)) 2683 if (SUBRP (fun))
2683 { 2684 val = funcall_subr (XSUBR (fun), numargs, args + 1);
2684 if (numargs < XSUBR (fun)->min_args
2685 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
2686 {
2687 XSETFASTINT (lisp_numargs, numargs);
2688 xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
2689 }
2690
2691 else if (XSUBR (fun)->max_args == UNEVALLED)
2692 xsignal1 (Qinvalid_function, original_fun);
2693
2694 else if (XSUBR (fun)->max_args == MANY)
2695 val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
2696 else
2697 {
2698 Lisp_Object internal_argbuf[8];
2699 if (XSUBR (fun)->max_args > numargs)
2700 {
2701 eassert (XSUBR (fun)->max_args <= ARRAYELTS (internal_argbuf));
2702 internal_args = internal_argbuf;
2703 memcpy (internal_args, args + 1, numargs * word_size);
2704 memclear (internal_args + numargs,
2705 (XSUBR (fun)->max_args - numargs) * word_size);
2706 }
2707 else
2708 internal_args = args + 1;
2709 switch (XSUBR (fun)->max_args)
2710 {
2711 case 0:
2712 val = (XSUBR (fun)->function.a0 ());
2713 break;
2714 case 1:
2715 val = (XSUBR (fun)->function.a1 (internal_args[0]));
2716 break;
2717 case 2:
2718 val = (XSUBR (fun)->function.a2
2719 (internal_args[0], internal_args[1]));
2720 break;
2721 case 3:
2722 val = (XSUBR (fun)->function.a3
2723 (internal_args[0], internal_args[1], internal_args[2]));
2724 break;
2725 case 4:
2726 val = (XSUBR (fun)->function.a4
2727 (internal_args[0], internal_args[1], internal_args[2],
2728 internal_args[3]));
2729 break;
2730 case 5:
2731 val = (XSUBR (fun)->function.a5
2732 (internal_args[0], internal_args[1], internal_args[2],
2733 internal_args[3], internal_args[4]));
2734 break;
2735 case 6:
2736 val = (XSUBR (fun)->function.a6
2737 (internal_args[0], internal_args[1], internal_args[2],
2738 internal_args[3], internal_args[4], internal_args[5]));
2739 break;
2740 case 7:
2741 val = (XSUBR (fun)->function.a7
2742 (internal_args[0], internal_args[1], internal_args[2],
2743 internal_args[3], internal_args[4], internal_args[5],
2744 internal_args[6]));
2745 break;
2746
2747 case 8:
2748 val = (XSUBR (fun)->function.a8
2749 (internal_args[0], internal_args[1], internal_args[2],
2750 internal_args[3], internal_args[4], internal_args[5],
2751 internal_args[6], internal_args[7]));
2752 break;
2753
2754 default:
2755
2756 /* If a subr takes more than 8 arguments without using MANY
2757 or UNEVALLED, we need to extend this function to support it.
2758 Until this is done, there is no way to call the function. */
2759 emacs_abort ();
2760 }
2761 }
2762 }
2763 else if (COMPILEDP (fun)) 2685 else if (COMPILEDP (fun))
2764 val = funcall_lambda (fun, numargs, args + 1); 2686 val = funcall_lambda (fun, numargs, args + 1);
2765 else 2687 else
@@ -2791,6 +2713,89 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2791 return val; 2713 return val;
2792} 2714}
2793 2715
2716
2717/* Apply a C subroutine SUBR to the NUMARGS evaluated arguments in ARG_VECTOR
2718 and return the result of evaluation. */
2719
2720Lisp_Object
2721funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
2722{
2723 if (numargs < subr->min_args
2724 || (subr->max_args >= 0 && subr->max_args < numargs))
2725 {
2726 Lisp_Object fun;
2727 XSETSUBR (fun, subr);
2728 xsignal2 (Qwrong_number_of_arguments, fun, make_number (numargs));
2729 }
2730
2731 else if (subr->max_args == UNEVALLED)
2732 {
2733 Lisp_Object fun;
2734 XSETSUBR (fun, subr);
2735 xsignal1 (Qinvalid_function, fun);
2736 }
2737
2738 else if (subr->max_args == MANY)
2739 return (subr->function.aMANY) (numargs, args);
2740 else
2741 {
2742 Lisp_Object internal_argbuf[8];
2743 Lisp_Object *internal_args;
2744 if (subr->max_args > numargs)
2745 {
2746 eassert (subr->max_args <= ARRAYELTS (internal_argbuf));
2747 internal_args = internal_argbuf;
2748 memcpy (internal_args, args, numargs * word_size);
2749 memclear (internal_args + numargs,
2750 (subr->max_args - numargs) * word_size);
2751 }
2752 else
2753 internal_args = args;
2754 switch (subr->max_args)
2755 {
2756 case 0:
2757 return (subr->function.a0 ());
2758 case 1:
2759 return (subr->function.a1 (internal_args[0]));
2760 case 2:
2761 return (subr->function.a2
2762 (internal_args[0], internal_args[1]));
2763 case 3:
2764 return (subr->function.a3
2765 (internal_args[0], internal_args[1], internal_args[2]));
2766 case 4:
2767 return (subr->function.a4
2768 (internal_args[0], internal_args[1], internal_args[2],
2769 internal_args[3]));
2770 case 5:
2771 return (subr->function.a5
2772 (internal_args[0], internal_args[1], internal_args[2],
2773 internal_args[3], internal_args[4]));
2774 case 6:
2775 return (subr->function.a6
2776 (internal_args[0], internal_args[1], internal_args[2],
2777 internal_args[3], internal_args[4], internal_args[5]));
2778 case 7:
2779 return (subr->function.a7
2780 (internal_args[0], internal_args[1], internal_args[2],
2781 internal_args[3], internal_args[4], internal_args[5],
2782 internal_args[6]));
2783 case 8:
2784 return (subr->function.a8
2785 (internal_args[0], internal_args[1], internal_args[2],
2786 internal_args[3], internal_args[4], internal_args[5],
2787 internal_args[6], internal_args[7]));
2788
2789 default:
2790
2791 /* If a subr takes more than 8 arguments without using MANY
2792 or UNEVALLED, we need to extend this function to support it.
2793 Until this is done, there is no way to call the function. */
2794 emacs_abort ();
2795 }
2796 }
2797}
2798
2794static Lisp_Object 2799static Lisp_Object
2795apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) 2800apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
2796{ 2801{
@@ -3171,10 +3176,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3171 specpdl_ptr->let.symbol = symbol; 3176 specpdl_ptr->let.symbol = symbol;
3172 specpdl_ptr->let.old_value = SYMBOL_VAL (sym); 3177 specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
3173 grow_specpdl (); 3178 grow_specpdl ();
3174 if (!sym->constant) 3179 if (!sym->trapped_write)
3175 SET_SYMBOL_VAL (sym, value); 3180 SET_SYMBOL_VAL (sym, value);
3176 else 3181 else
3177 set_internal (symbol, value, Qnil, 1); 3182 set_internal (symbol, value, Qnil, SET_INTERNAL_BIND);
3178 break; 3183 break;
3179 case SYMBOL_LOCALIZED: 3184 case SYMBOL_LOCALIZED:
3180 if (SYMBOL_BLV (sym)->frame_local) 3185 if (SYMBOL_BLV (sym)->frame_local)
@@ -3214,7 +3219,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3214 specpdl_ptr->let.kind = SPECPDL_LET; 3219 specpdl_ptr->let.kind = SPECPDL_LET;
3215 3220
3216 grow_specpdl (); 3221 grow_specpdl ();
3217 set_internal (symbol, value, Qnil, 1); 3222 set_internal (symbol, value, Qnil, SET_INTERNAL_BIND);
3218 break; 3223 break;
3219 } 3224 }
3220 default: emacs_abort (); 3225 default: emacs_abort ();
@@ -3341,14 +3346,16 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
3341 case SPECPDL_BACKTRACE: 3346 case SPECPDL_BACKTRACE:
3342 break; 3347 break;
3343 case SPECPDL_LET: 3348 case SPECPDL_LET:
3344 { /* If variable has a trivial value (no forwarding), we can 3349 { /* If variable has a trivial value (no forwarding), and
3345 just set it. No need to check for constant symbols here, 3350 isn't trapped, we can just set it. */
3346 since that was already done by specbind. */
3347 Lisp_Object sym = specpdl_symbol (specpdl_ptr); 3351 Lisp_Object sym = specpdl_symbol (specpdl_ptr);
3348 if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL) 3352 if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
3349 { 3353 {
3350 SET_SYMBOL_VAL (XSYMBOL (sym), 3354 if (XSYMBOL (sym)->trapped_write == SYMBOL_UNTRAPPED_WRITE)
3351 specpdl_old_value (specpdl_ptr)); 3355 SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (specpdl_ptr));
3356 else
3357 set_internal (sym, specpdl_old_value (specpdl_ptr),
3358 Qnil, SET_INTERNAL_UNBIND);
3352 break; 3359 break;
3353 } 3360 }
3354 else 3361 else
@@ -3371,7 +3378,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
3371 /* If this was a local binding, reset the value in the appropriate 3378 /* If this was a local binding, reset the value in the appropriate
3372 buffer, but only if that buffer's binding still exists. */ 3379 buffer, but only if that buffer's binding still exists. */
3373 if (!NILP (Flocal_variable_p (symbol, where))) 3380 if (!NILP (Flocal_variable_p (symbol, where)))
3374 set_internal (symbol, old_value, where, 1); 3381 set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND);
3375 } 3382 }
3376 break; 3383 break;
3377 } 3384 }
@@ -3596,7 +3603,7 @@ backtrace_eval_unrewind (int distance)
3596 { 3603 {
3597 set_specpdl_old_value 3604 set_specpdl_old_value
3598 (tmp, Fbuffer_local_value (symbol, where)); 3605 (tmp, Fbuffer_local_value (symbol, where));
3599 set_internal (symbol, old_value, where, 1); 3606 set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND);
3600 } 3607 }
3601 } 3608 }
3602 break; 3609 break;
@@ -3940,6 +3947,7 @@ alist of active lexical bindings. */);
3940 defsubr (&Sset_default_toplevel_value); 3947 defsubr (&Sset_default_toplevel_value);
3941 defsubr (&Sdefvar); 3948 defsubr (&Sdefvar);
3942 defsubr (&Sdefvaralias); 3949 defsubr (&Sdefvaralias);
3950 DEFSYM (Qdefvaralias, "defvaralias");
3943 defsubr (&Sdefconst); 3951 defsubr (&Sdefconst);
3944 defsubr (&Smake_var_non_special); 3952 defsubr (&Smake_var_non_special);
3945 defsubr (&Slet); 3953 defsubr (&Slet);
diff --git a/src/font.c b/src/font.c
index 9fe7c26ea9c..36e71669453 100644
--- a/src/font.c
+++ b/src/font.c
@@ -5415,19 +5415,19 @@ Each element has the form:
5415 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...] 5415 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5416NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */); 5416NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5417 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table); 5417 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
5418 XSYMBOL (intern_c_string ("font-weight-table"))->constant = 1; 5418 make_symbol_constant (intern_c_string ("font-weight-table"));
5419 5419
5420 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table, 5420 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table,
5421 doc: /* Vector of font slant symbols vs the corresponding numeric values. 5421 doc: /* Vector of font slant symbols vs the corresponding numeric values.
5422See `font-weight-table' for the format of the vector. */); 5422See `font-weight-table' for the format of the vector. */);
5423 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table); 5423 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
5424 XSYMBOL (intern_c_string ("font-slant-table"))->constant = 1; 5424 make_symbol_constant (intern_c_string ("font-slant-table"));
5425 5425
5426 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table, 5426 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table,
5427 doc: /* Alist of font width symbols vs the corresponding numeric values. 5427 doc: /* Alist of font width symbols vs the corresponding numeric values.
5428See `font-weight-table' for the format of the vector. */); 5428See `font-weight-table' for the format of the vector. */);
5429 Vfont_width_table = BUILD_STYLE_TABLE (width_table); 5429 Vfont_width_table = BUILD_STYLE_TABLE (width_table);
5430 XSYMBOL (intern_c_string ("font-width-table"))->constant = 1; 5430 make_symbol_constant (intern_c_string ("font-width-table"));
5431 5431
5432 staticpro (&font_style_table); 5432 staticpro (&font_style_table);
5433 font_style_table = make_uninit_vector (3); 5433 font_style_table = make_uninit_vector (3);
diff --git a/src/lisp.h b/src/lisp.h
index b6c46687b28..94f1152a56e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -320,7 +320,8 @@ error !;
320#define lisp_h_NILP(x) EQ (x, Qnil) 320#define lisp_h_NILP(x) EQ (x, Qnil)
321#define lisp_h_SET_SYMBOL_VAL(sym, v) \ 321#define lisp_h_SET_SYMBOL_VAL(sym, v) \
322 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) 322 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
323#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) 323#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->trapped_write == SYMBOL_NOWRITE)
324#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->trapped_write)
324#define lisp_h_SYMBOL_VAL(sym) \ 325#define lisp_h_SYMBOL_VAL(sym) \
325 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) 326 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
326#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) 327#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
@@ -375,6 +376,7 @@ error !;
375# define NILP(x) lisp_h_NILP (x) 376# define NILP(x) lisp_h_NILP (x)
376# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) 377# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
377# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) 378# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
379# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
378# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) 380# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
379# define SYMBOLP(x) lisp_h_SYMBOLP (x) 381# define SYMBOLP(x) lisp_h_SYMBOLP (x)
380# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) 382# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
@@ -600,6 +602,9 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object);
600/* Defined in data.c. */ 602/* Defined in data.c. */
601extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); 603extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
602extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); 604extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object);
605extern void notify_variable_watchers (Lisp_Object symbol, Lisp_Object newval,
606 Lisp_Object operation, Lisp_Object where);
607
603 608
604#ifdef CANNOT_DUMP 609#ifdef CANNOT_DUMP
605enum { might_dump = false }; 610enum { might_dump = false };
@@ -632,6 +637,13 @@ enum symbol_redirect
632 SYMBOL_FORWARDED = 3 637 SYMBOL_FORWARDED = 3
633}; 638};
634 639
640enum symbol_trapped_write
641{
642 SYMBOL_UNTRAPPED_WRITE = 0,
643 SYMBOL_NOWRITE = 1,
644 SYMBOL_TRAPPED_WRITE = 2
645};
646
635struct Lisp_Symbol 647struct Lisp_Symbol
636{ 648{
637 bool_bf gcmarkbit : 1; 649 bool_bf gcmarkbit : 1;
@@ -643,10 +655,10 @@ struct Lisp_Symbol
643 3 : it's a forwarding variable, the value is in `forward'. */ 655 3 : it's a forwarding variable, the value is in `forward'. */
644 ENUM_BF (symbol_redirect) redirect : 3; 656 ENUM_BF (symbol_redirect) redirect : 3;
645 657
646 /* Non-zero means symbol is constant, i.e. changing its value 658 /* 0 : normal case, just set the value
647 should signal an error. If the value is 3, then the var 659 1 : constant, cannot set, e.g. nil, t, :keywords.
648 can be changed, but only by `defconst'. */ 660 2 : trap the write, call watcher functions. */
649 unsigned constant : 2; 661 ENUM_BF (symbol_trapped_write) trapped_write : 2;
650 662
651 /* Interned state of the symbol. This is an enumerator from 663 /* Interned state of the symbol. This is an enumerator from
652 enum symbol_interned. */ 664 enum symbol_interned. */
@@ -1850,9 +1862,20 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
1850 return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; 1862 return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
1851} 1863}
1852 1864
1853/* Value is non-zero if symbol is considered a constant, i.e. its 1865/* Value is non-zero if symbol cannot be changed through a simple set,
1854 value cannot be changed (there is an exception for keyword symbols, 1866 i.e. it's a constant (e.g. nil, t, :keywords), or it has some
1855 whose value can be set to the keyword symbol itself). */ 1867 watching functions. */
1868
1869INLINE int
1870(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym)
1871{
1872 return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym);
1873}
1874
1875/* Value is non-zero if symbol cannot be changed at all, i.e. it's a
1876 constant (e.g. nil, t, :keywords). Code that actually wants to
1877 write to SYM, should also check whether there are any watching
1878 functions. */
1856 1879
1857INLINE int 1880INLINE int
1858(SYMBOL_CONSTANT_P) (Lisp_Object sym) 1881(SYMBOL_CONSTANT_P) (Lisp_Object sym)
@@ -3286,6 +3309,12 @@ set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
3286 XSYMBOL (sym)->next = next; 3309 XSYMBOL (sym)->next = next;
3287} 3310}
3288 3311
3312INLINE void
3313make_symbol_constant (Lisp_Object sym)
3314{
3315 XSYMBOL (sym)->trapped_write = SYMBOL_NOWRITE;
3316}
3317
3289/* Buffer-local (also frame-local) variable access functions. */ 3318/* Buffer-local (also frame-local) variable access functions. */
3290 3319
3291INLINE int 3320INLINE int
@@ -3394,7 +3423,13 @@ extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
3394extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, 3423extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
3395 Lisp_Object); 3424 Lisp_Object);
3396extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); 3425extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
3397extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool); 3426enum Set_Internal_Bind {
3427 SET_INTERNAL_SET,
3428 SET_INTERNAL_BIND,
3429 SET_INTERNAL_UNBIND
3430};
3431extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object,
3432 enum Set_Internal_Bind);
3398extern void syms_of_data (void); 3433extern void syms_of_data (void);
3399extern void swap_in_global_binding (struct Lisp_Symbol *); 3434extern void swap_in_global_binding (struct Lisp_Symbol *);
3400 3435
@@ -3877,6 +3912,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
3877extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, 3912extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
3878 Lisp_Object); 3913 Lisp_Object);
3879extern _Noreturn void signal_error (const char *, Lisp_Object); 3914extern _Noreturn void signal_error (const char *, Lisp_Object);
3915extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector);
3880extern Lisp_Object eval_sub (Lisp_Object form); 3916extern Lisp_Object eval_sub (Lisp_Object form);
3881extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); 3917extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
3882extern Lisp_Object call0 (Lisp_Object); 3918extern Lisp_Object call0 (Lisp_Object);
diff --git a/src/lread.c b/src/lread.c
index eab9b8bea08..14f9393cc47 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3833,7 +3833,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
3833 3833
3834 if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) 3834 if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
3835 { 3835 {
3836 XSYMBOL (sym)->constant = 1; 3836 make_symbol_constant (sym);
3837 XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; 3837 XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
3838 SET_SYMBOL_VAL (XSYMBOL (sym), sym); 3838 SET_SYMBOL_VAL (XSYMBOL (sym), sym);
3839 } 3839 }
@@ -4120,12 +4120,12 @@ init_obarray (void)
4120 4120
4121 DEFSYM (Qnil, "nil"); 4121 DEFSYM (Qnil, "nil");
4122 SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); 4122 SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
4123 XSYMBOL (Qnil)->constant = 1; 4123 make_symbol_constant (Qnil);
4124 XSYMBOL (Qnil)->declared_special = true; 4124 XSYMBOL (Qnil)->declared_special = true;
4125 4125
4126 DEFSYM (Qt, "t"); 4126 DEFSYM (Qt, "t");
4127 SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); 4127 SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
4128 XSYMBOL (Qt)->constant = 1; 4128 make_symbol_constant (Qt);
4129 XSYMBOL (Qt)->declared_special = true; 4129 XSYMBOL (Qt)->declared_special = true;
4130 4130
4131 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ 4131 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
diff --git a/src/window.h b/src/window.h
index a124b3311d0..4a102f2246e 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1063,7 +1063,6 @@ extern void wset_redisplay (struct window *w);
1063extern void fset_redisplay (struct frame *f); 1063extern void fset_redisplay (struct frame *f);
1064extern void bset_redisplay (struct buffer *b); 1064extern void bset_redisplay (struct buffer *b);
1065extern void bset_update_mode_line (struct buffer *b); 1065extern void bset_update_mode_line (struct buffer *b);
1066extern void maybe_set_redisplay (Lisp_Object);
1067/* Call this to tell redisplay to look for other windows than selected-window 1066/* Call this to tell redisplay to look for other windows than selected-window
1068 that need to be redisplayed. Calling one of the *set_redisplay functions 1067 that need to be redisplayed. Calling one of the *set_redisplay functions
1069 above already does it, so it's only needed in unusual cases. */ 1068 above already does it, so it's only needed in unusual cases. */
diff --git a/src/xdisp.c b/src/xdisp.c
index 2acdfa90b7a..ad0b9686f04 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -622,15 +622,15 @@ bset_update_mode_line (struct buffer *b)
622 b->text->redisplay = true; 622 b->text->redisplay = true;
623} 623}
624 624
625void 625DEFUN ("set-buffer-redisplay", Fset_buffer_redisplay,
626maybe_set_redisplay (Lisp_Object symbol) 626 Sset_buffer_redisplay, 4, 4, 0,
627{ 627 doc: /* Mark the current buffer for redisplay.
628 if (HASH_TABLE_P (Vredisplay__variables) 628This function may be passed to `add-variable-watcher'. */)
629 && hash_lookup (XHASH_TABLE (Vredisplay__variables), symbol, NULL) >= 0) 629 (Lisp_Object symbol, Lisp_Object newval, Lisp_Object op, Lisp_Object where)
630 { 630{
631 bset_update_mode_line (current_buffer); 631 bset_update_mode_line (current_buffer);
632 current_buffer->prevent_redisplay_optimizations_p = true; 632 current_buffer->prevent_redisplay_optimizations_p = true;
633 } 633 return Qnil;
634} 634}
635 635
636#ifdef GLYPH_DEBUG 636#ifdef GLYPH_DEBUG
@@ -31322,6 +31322,7 @@ They are still logged to the *Messages* buffer. */);
31322 message_dolog_marker3 = Fmake_marker (); 31322 message_dolog_marker3 = Fmake_marker ();
31323 staticpro (&message_dolog_marker3); 31323 staticpro (&message_dolog_marker3);
31324 31324
31325 defsubr (&Sset_buffer_redisplay);
31325#ifdef GLYPH_DEBUG 31326#ifdef GLYPH_DEBUG
31326 defsubr (&Sdump_frame_glyph_matrix); 31327 defsubr (&Sdump_frame_glyph_matrix);
31327 defsubr (&Sdump_glyph_matrix); 31328 defsubr (&Sdump_glyph_matrix);
@@ -31991,10 +31992,6 @@ display table takes effect; in this case, Emacs does not consult
31991 doc: /* */); 31992 doc: /* */);
31992 Vredisplay__mode_lines_cause = Fmake_hash_table (0, NULL); 31993 Vredisplay__mode_lines_cause = Fmake_hash_table (0, NULL);
31993 31994
31994 DEFVAR_LISP ("redisplay--variables", Vredisplay__variables,
31995 doc: /* A hash-table of variables changing which triggers a thorough redisplay. */);
31996 Vredisplay__variables = Qnil;
31997
31998 DEFVAR_BOOL ("redisplay--inhibit-bidi", redisplay__inhibit_bidi, 31995 DEFVAR_BOOL ("redisplay--inhibit-bidi", redisplay__inhibit_bidi,
31999 doc: /* Non-nil means it is not safe to attempt bidi reordering for display. */); 31996 doc: /* Non-nil means it is not safe to attempt bidi reordering for display. */);
32000 /* Initialize to t, since we need to disable reordering until 31997 /* Initialize to t, since we need to disable reordering until
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 0a292336f35..4c2ea54862c 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -255,3 +255,118 @@ comparing the subr with a much slower lisp implementation."
255 (v2 (test-bool-vector-bv-from-hex-string "0000C")) 255 (v2 (test-bool-vector-bv-from-hex-string "0000C"))
256 (v3 (bool-vector-not v1))) 256 (v3 (bool-vector-not v1)))
257 (should (equal v2 v3)))) 257 (should (equal v2 v3))))
258
259(ert-deftest data-tests-variable-watchers ()
260 (defvar data-tests-var 0)
261 (let* ((watch-data nil)
262 (collect-watch-data
263 (lambda (&rest args) (push args watch-data))))
264 (cl-flet ((should-have-watch-data (data)
265 (should (equal (pop watch-data) data))
266 (should (null watch-data))))
267 (add-variable-watcher 'data-tests-var collect-watch-data)
268 (setq data-tests-var 1)
269 (should-have-watch-data '(data-tests-var 1 set nil))
270 (let ((data-tests-var 2))
271 (should-have-watch-data '(data-tests-var 2 let nil))
272 (setq data-tests-var 3)
273 (should-have-watch-data '(data-tests-var 3 set nil)))
274 (should-have-watch-data '(data-tests-var 1 unlet nil))
275 ;; `setq-default' on non-local variable is same as `setq'.
276 (setq-default data-tests-var 4)
277 (should-have-watch-data '(data-tests-var 4 set nil))
278 (makunbound 'data-tests-var)
279 (should-have-watch-data '(data-tests-var nil makunbound nil))
280 (setq data-tests-var 5)
281 (should-have-watch-data '(data-tests-var 5 set nil))
282 (remove-variable-watcher 'data-tests-var collect-watch-data)
283 (setq data-tests-var 6)
284 (should (null watch-data)))))
285
286(ert-deftest data-tests-varalias-watchers ()
287 (defvar data-tests-var0 0)
288 (defvar data-tests-var1 0)
289 (defvar data-tests-var2 0)
290 (defvar data-tests-var3 0)
291 (let* ((watch-data nil)
292 (collect-watch-data
293 (lambda (&rest args) (push args watch-data))))
294 (cl-flet ((should-have-watch-data (data)
295 (should (equal (pop watch-data) data))
296 (should (null watch-data))))
297 ;; Watch var0, then alias it.
298 (add-variable-watcher 'data-tests-var0 collect-watch-data)
299 (defvaralias 'data-tests-var0-alias 'data-tests-var0)
300 (setq data-tests-var0 1)
301 (should-have-watch-data '(data-tests-var0 1 set nil))
302 (setq data-tests-var0-alias 2)
303 (should-have-watch-data '(data-tests-var0 2 set nil))
304 ;; Alias var1, then watch var1-alias.
305 (defvaralias 'data-tests-var1-alias 'data-tests-var1)
306 (add-variable-watcher 'data-tests-var1-alias collect-watch-data)
307 (setq data-tests-var1 1)
308 (should-have-watch-data '(data-tests-var1 1 set nil))
309 (setq data-tests-var1-alias 2)
310 (should-have-watch-data '(data-tests-var1 2 set nil))
311 ;; Alias var2, then watch it.
312 (defvaralias 'data-tests-var2-alias 'data-tests-var2)
313 (add-variable-watcher 'data-tests-var2 collect-watch-data)
314 (setq data-tests-var2 1)
315 (should-have-watch-data '(data-tests-var2 1 set nil))
316 (setq data-tests-var2-alias 2)
317 (should-have-watch-data '(data-tests-var2 2 set nil))
318 ;; Watch var3-alias, then make it alias var3 (this removes the
319 ;; watcher flag).
320 (defvar data-tests-var3-alias 0)
321 (add-variable-watcher 'data-tests-var3-alias collect-watch-data)
322 (defvaralias 'data-tests-var3-alias 'data-tests-var3)
323 (should-have-watch-data '(data-tests-var3-alias
324 data-tests-var3 defvaralias nil))
325 (setq data-tests-var3 1)
326 (setq data-tests-var3-alias 2)
327 (should (null watch-data)))))
328
329(ert-deftest data-tests-local-variable-watchers ()
330 (defvar-local data-tests-lvar 0)
331 (let* ((buf1 (current-buffer))
332 (buf2 nil)
333 (watch-data nil)
334 (collect-watch-data
335 (lambda (&rest args) (push args watch-data))))
336 (cl-flet ((should-have-watch-data (data)
337 (should (equal (pop watch-data) data))
338 (should (null watch-data))))
339 (add-variable-watcher 'data-tests-lvar collect-watch-data)
340 (setq data-tests-lvar 1)
341 (should-have-watch-data `(data-tests-lvar 1 set ,buf1))
342 (let ((data-tests-lvar 2))
343 (should-have-watch-data `(data-tests-lvar 2 let ,buf1))
344 (setq data-tests-lvar 3)
345 (should-have-watch-data `(data-tests-lvar 3 set ,buf1)))
346 (should-have-watch-data `(data-tests-lvar 1 unlet ,buf1))
347 (setq-default data-tests-lvar 4)
348 (should-have-watch-data `(data-tests-lvar 4 set nil))
349 (with-temp-buffer
350 (setq buf2 (current-buffer))
351 (setq data-tests-lvar 1)
352 (should-have-watch-data `(data-tests-lvar 1 set ,buf2))
353 (let ((data-tests-lvar 2))
354 (should-have-watch-data `(data-tests-lvar 2 let ,buf2))
355 (setq data-tests-lvar 3)
356 (should-have-watch-data `(data-tests-lvar 3 set ,buf2)))
357 (should-have-watch-data `(data-tests-lvar 1 unlet ,buf2))
358 (kill-local-variable 'data-tests-lvar)
359 (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2))
360 (setq data-tests-lvar 3.5)
361 (should-have-watch-data `(data-tests-lvar 3.5 set ,buf2))
362 (kill-all-local-variables)
363 (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2)))
364 (setq-default data-tests-lvar 4)
365 (should-have-watch-data `(data-tests-lvar 4 set nil))
366 (makunbound 'data-tests-lvar)
367 (should-have-watch-data '(data-tests-lvar nil makunbound nil))
368 (setq data-tests-lvar 5)
369 (should-have-watch-data `(data-tests-lvar 5 set ,buf1))
370 (remove-variable-watcher 'data-tests-lvar collect-watch-data)
371 (setq data-tests-lvar 6)
372 (should (null watch-data)))))