diff options
| author | Noam Postavsky | 2016-12-02 20:39:10 -0500 |
|---|---|---|
| committer | Noam Postavsky | 2016-12-02 20:44:47 -0500 |
| commit | 88fefc3291060f18503738aaa4e81b98f1970a55 (patch) | |
| tree | f5d3a464be2d1472af9f0b754f8d22e915fc4cec | |
| parent | 0fc4761ca88175c30da7209c9ab1cde788b66a76 (diff) | |
| parent | 56c817837bff3ffef587a9c80d619b9fe4886159 (diff) | |
| download | emacs-88fefc3291060f18503738aaa4e81b98f1970a55.tar.gz emacs-88fefc3291060f18503738aaa4e81b98f1970a55.zip | |
; Merge: Lisp watchpoints (Bug#24923)
| -rw-r--r-- | doc/lispref/debugging.texi | 31 | ||||
| -rw-r--r-- | doc/lispref/elisp.texi | 2 | ||||
| -rw-r--r-- | doc/lispref/variables.texi | 61 | ||||
| -rw-r--r-- | etc/NEWS | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/debug.el | 91 | ||||
| -rw-r--r-- | lisp/frame.el | 3 | ||||
| -rw-r--r-- | lisp/help-fns.el | 7 | ||||
| -rw-r--r-- | src/alloc.c | 2 | ||||
| -rw-r--r-- | src/buffer.c | 82 | ||||
| -rw-r--r-- | src/bytecode.c | 4 | ||||
| -rw-r--r-- | src/data.c | 213 | ||||
| -rw-r--r-- | src/eval.c | 206 | ||||
| -rw-r--r-- | src/font.c | 6 | ||||
| -rw-r--r-- | src/lisp.h | 54 | ||||
| -rw-r--r-- | src/lread.c | 6 | ||||
| -rw-r--r-- | src/window.h | 1 | ||||
| -rw-r--r-- | src/xdisp.c | 23 | ||||
| -rw-r--r-- | test/src/data-tests.el | 115 |
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 | |||
| 290 | not currently set up to break on entry. | 291 | not 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 | |||
| 299 | Sometimes a problem with a function is due to a wrong setting of a | ||
| 300 | variable. Setting up the debugger to trigger whenever the variable is | ||
| 301 | changed is a quick way to find the origin of the setting. | ||
| 302 | |||
| 303 | @deffn Command debug-on-variable-change variable | ||
| 304 | This function arranges for the debugger to be called whenever | ||
| 305 | @var{variable} is modified. | ||
| 306 | |||
| 307 | It is implemented using the watchpoint mechanism, so it inherits the | ||
| 308 | same characteristics and limitations: all aliases of @var{variable} | ||
| 309 | will be watched together, only dynamic variables can be watched, and | ||
| 310 | changes to the objects referenced by variables are not detected. For | ||
| 311 | details, see @ref{Watching Variables}. | ||
| 312 | @end deffn | ||
| 313 | |||
| 314 | @deffn Command cancel-debug-on-variable-change &optional variable | ||
| 315 | This 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 | ||
| 320 | which 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 | |||
| 775 | It is sometimes useful to take some action when a variable changes its | ||
| 776 | value. The watchpoint facility provides the means to do so. Some | ||
| 777 | possible uses for this feature include keeping display in sync with | ||
| 778 | variable settings, and invoking the debugger to track down unexpected | ||
| 779 | changes to variables (@pxref{Variable Debugging}). | ||
| 780 | |||
| 781 | The following functions may be used to manipulate and query the watch | ||
| 782 | functions for a variable. | ||
| 783 | |||
| 784 | @defun add-variable-watcher symbol watch-function | ||
| 785 | This 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 | ||
| 797 | being changed, nil otherwise. | ||
| 798 | @end defun | ||
| 799 | |||
| 800 | @defun remove-variable-watch symbol watch-function | ||
| 801 | This function removes @var{watch-function} from @var{symbol}'s list of | ||
| 802 | watchers. | ||
| 803 | @end defun | ||
| 804 | |||
| 805 | @defun get-variable-watchers symbol | ||
| 806 | This function returns the list of @var{symbol}'s active watcher | ||
| 807 | functions. | ||
| 808 | @end defun | ||
| 809 | |||
| 810 | @subsection Limitations | ||
| 811 | |||
| 812 | There are a couple of ways in which a variable could be modifed (or at | ||
| 813 | least appear to be modified) without triggering a watchpoint. | ||
| 814 | |||
| 815 | Since watchpoints are attached to symbols, modification to the | ||
| 816 | objects contained within variables (e.g., by a list modification | ||
| 817 | function @pxref{Modifying Lists}) is not caught by this mechanism. | ||
| 818 | |||
| 819 | Additionally, C code can modify the value of variables directly, | ||
| 820 | bypassing the watchpoint mechanism. | ||
| 821 | |||
| 822 | A minor limitation of this feature, again because it targets symbols, | ||
| 823 | is that only variables of dynamic scope may be watched. This poses | ||
| 824 | little difficulty, since modifications to lexical variables can be | ||
| 825 | discovered easily by inspecting the code within the scope of the | ||
| 826 | variable (unlike dynamic variables, which can be modified by any code | ||
| 827 | at 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 |
| @@ -716,6 +716,11 @@ consistency with the new functions. For compatibility, 'sxhash' | |||
| 716 | remains as an alias to 'sxhash-equal'. | 716 | remains as an alias to 'sxhash-equal'. |
| 717 | 717 | ||
| 718 | +++ | 718 | +++ |
| 719 | ** New function `add-variable-watcher' can be used to call a function | ||
| 720 | when a symbol's value is changed. This is used to implement the new | ||
| 721 | debugger 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 |
| 720 | allow it to be OFFSET or a list (OFFSET ABBR), where the integer | 725 | allow it to be OFFSET or a list (OFFSET ABBR), where the integer |
| 721 | OFFSET is a count of seconds east of Universal Time, and the string | 726 | OFFSET 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. | ||
| 873 | This 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 | |||
| 883 | When called interactively, prompt for VARIABLE in the minibuffer. | ||
| 884 | |||
| 885 | This works by calling `add-variable-watch' on VARIABLE. If you | ||
| 886 | quit from the debugger, this will abort the change (unless the | ||
| 887 | change is caused by the termination of a let-binding). | ||
| 888 | |||
| 889 | The watchpoint may be circumvented by C code that changes the | ||
| 890 | variable directly (i.e., not via `set'). Changing the value of | ||
| 891 | the variable (e.g., `setcar' on a list variable) will not trigger | ||
| 892 | watchpoint. | ||
| 893 | |||
| 894 | Use \\[cancel-debug-on-variable-change] to cancel the effect of | ||
| 895 | this command. Uninterning VARIABLE or making it an alias of | ||
| 896 | another 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. | ||
| 925 | If VARIABLE is nil, cancel debug-on-variable-change for all variables. | ||
| 926 | When called interactively, prompt for VARIABLE in the minibuffer. | ||
| 927 | To 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. | |||
| 5541 | This variable is buffer-local but you cannot set it directly; | 5555 | This variable is buffer-local but you cannot set it directly; |
| 5542 | use the function `set-buffer-multibyte' to change a buffer's representation. | 5556 | use the function `set-buffer-multibyte' to change a buffer's representation. |
| 5543 | See also Info node `(elisp)Text Representations'. */); | 5557 | See 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 | ||
| 1240 | void | 1241 | void |
| 1241 | set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, | 1242 | set_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 | |||
| 1401 | static void | ||
| 1402 | set_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 | |||
| 1413 | static void | ||
| 1414 | restore_symbol_trapped_write (Lisp_Object symbol) | ||
| 1415 | { | ||
| 1416 | set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE); | ||
| 1417 | } | ||
| 1418 | |||
| 1419 | static void | ||
| 1420 | harmonize_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 | |||
| 1428 | DEFUN ("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 | |||
| 1432 | It will be called with 4 arguments: (SYMBOL NEWVAL OPERATION WHERE). | ||
| 1433 | SYMBOL is the variable being changed. | ||
| 1434 | NEWVAL is the value it will be changed to. | ||
| 1435 | OPERATION is a symbol representing the kind of change, one of: `set', | ||
| 1436 | `let', `unlet', `makunbound', and `defvaralias'. | ||
| 1437 | WHERE is a buffer if the buffer-local value of the variable being | ||
| 1438 | changed, nil otherwise. | ||
| 1439 | |||
| 1440 | All 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 | |||
| 1454 | DEFUN ("remove-variable-watcher", Fremove_variable_watcher, Sremove_variable_watcher, | ||
| 1455 | 2, 2, 0, | ||
| 1456 | doc: /* Undo the effect of `add-variable-watcher'. | ||
| 1457 | Remove WATCH-FUNCTION from the list of functions to be called when | ||
| 1458 | SYMBOL (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 | |||
| 1473 | DEFUN ("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 | |||
| 1483 | void | ||
| 1484 | notify_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 | |||
| 2720 | Lisp_Object | ||
| 2721 | funcall_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 | |||
| 2794 | static Lisp_Object | 2799 | static Lisp_Object |
| 2795 | apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) | 2800 | apply_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 ...] |
| 5416 | NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */); | 5416 | NUMERIC-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. |
| 5422 | See `font-weight-table' for the format of the vector. */); | 5422 | See `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. |
| 5428 | See `font-weight-table' for the format of the vector. */); | 5428 | See `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. */ |
| 601 | extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); | 603 | extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); |
| 602 | extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); | 604 | extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); |
| 605 | extern 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 |
| 605 | enum { might_dump = false }; | 610 | enum { might_dump = false }; |
| @@ -632,6 +637,13 @@ enum symbol_redirect | |||
| 632 | SYMBOL_FORWARDED = 3 | 637 | SYMBOL_FORWARDED = 3 |
| 633 | }; | 638 | }; |
| 634 | 639 | ||
| 640 | enum symbol_trapped_write | ||
| 641 | { | ||
| 642 | SYMBOL_UNTRAPPED_WRITE = 0, | ||
| 643 | SYMBOL_NOWRITE = 1, | ||
| 644 | SYMBOL_TRAPPED_WRITE = 2 | ||
| 645 | }; | ||
| 646 | |||
| 635 | struct Lisp_Symbol | 647 | struct 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 | |||
| 1869 | INLINE 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 | ||
| 1857 | INLINE int | 1880 | INLINE 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 | ||
| 3312 | INLINE void | ||
| 3313 | make_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 | ||
| 3291 | INLINE int | 3320 | INLINE int |
| @@ -3394,7 +3423,13 @@ extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); | |||
| 3394 | extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, | 3423 | extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, |
| 3395 | Lisp_Object); | 3424 | Lisp_Object); |
| 3396 | extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); | 3425 | extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); |
| 3397 | extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool); | 3426 | enum Set_Internal_Bind { |
| 3427 | SET_INTERNAL_SET, | ||
| 3428 | SET_INTERNAL_BIND, | ||
| 3429 | SET_INTERNAL_UNBIND | ||
| 3430 | }; | ||
| 3431 | extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, | ||
| 3432 | enum Set_Internal_Bind); | ||
| 3398 | extern void syms_of_data (void); | 3433 | extern void syms_of_data (void); |
| 3399 | extern void swap_in_global_binding (struct Lisp_Symbol *); | 3434 | extern void swap_in_global_binding (struct Lisp_Symbol *); |
| 3400 | 3435 | ||
| @@ -3877,6 +3912,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object); | |||
| 3877 | extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, | 3912 | extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, |
| 3878 | Lisp_Object); | 3913 | Lisp_Object); |
| 3879 | extern _Noreturn void signal_error (const char *, Lisp_Object); | 3914 | extern _Noreturn void signal_error (const char *, Lisp_Object); |
| 3915 | extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); | ||
| 3880 | extern Lisp_Object eval_sub (Lisp_Object form); | 3916 | extern Lisp_Object eval_sub (Lisp_Object form); |
| 3881 | extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); | 3917 | extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); |
| 3882 | extern Lisp_Object call0 (Lisp_Object); | 3918 | extern 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); | |||
| 1063 | extern void fset_redisplay (struct frame *f); | 1063 | extern void fset_redisplay (struct frame *f); |
| 1064 | extern void bset_redisplay (struct buffer *b); | 1064 | extern void bset_redisplay (struct buffer *b); |
| 1065 | extern void bset_update_mode_line (struct buffer *b); | 1065 | extern void bset_update_mode_line (struct buffer *b); |
| 1066 | extern 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 | ||
| 625 | void | 625 | DEFUN ("set-buffer-redisplay", Fset_buffer_redisplay, |
| 626 | maybe_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) | 628 | This 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))))) | ||