commit 143a4306759a91e84b486a9e4c52f83d96d8d23d (HEAD, refs/remotes/origin/master) Author: Mark Oteiza Date: Fri Dec 2 16:53:02 2016 -0500 Display window before calculating width * lisp/image-dired.el (image-dired-display-thumbs): Display the buffer before calling image-dired-line-up and friends, which in turn calculate the window width. Otherwise, the thumbnail layout will be wrong in a side-by-side split. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 714182a..67fbc02 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -854,6 +854,9 @@ thumbnail buffer to be selected." (message "Thumb could not be created for file %s" curr-file) (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) files)) + (if do-not-pop + (display-buffer buf) + (pop-to-buffer buf)) (cond ((eq 'dynamic image-dired-line-up-method) (image-dired-line-up-dynamic)) ((eq 'fixed image-dired-line-up-method) @@ -863,10 +866,7 @@ thumbnail buffer to be selected." ((eq 'none image-dired-line-up-method) nil) (t - (image-dired-line-up-dynamic)))) - (if do-not-pop - (display-buffer image-dired-thumbnail-buffer) - (pop-to-buffer image-dired-thumbnail-buffer)))) + (image-dired-line-up-dynamic)))))) ;;;###autoload (defun image-dired-show-all-from-dir (dir) commit 5e915691ff097668b60c715cd39ab87975fc3000 Author: Mark Oteiza Date: Fri Dec 2 16:50:25 2016 -0500 Use pop-to-buffer-same-window * lisp/image-dired.el (image-dired-dired-with-window-configuration): (image-dired-dired-edit-comment-and-tags): Instead of switch-to-buffer, use pop-to-buffer-same-window cf. Bug#22244. (image-dired-forward-image, image-dired-backward-image): Ignore unused. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index a55dd40..714182a 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -799,9 +799,9 @@ calling `image-dired-restore-window-configuration'." (setq truncate-lines t) (save-excursion (other-window 1) - (switch-to-buffer buf) + (pop-to-buffer-same-window buf) (select-window (split-window-below)) - (switch-to-buffer buf2) + (pop-to-buffer-same-window buf2) (other-window -2))))) (defun image-dired-restore-window-configuration () @@ -1110,7 +1110,7 @@ Optional prefix ARG says how many images to move; default is one image." (interactive "p") (let (pos (steps (or arg 1))) - (dotimes (i steps) + (dotimes (_ steps) (if (and (not (eobp)) (save-excursion (forward-char) @@ -1131,7 +1131,7 @@ Optional prefix ARG says how many images to move; default is one image." (interactive "p") (let (pos (steps (or arg 1))) - (dotimes (i steps) + (dotimes (_ steps) (if (and (not (bobp)) (save-excursion (backward-char) @@ -2484,7 +2484,7 @@ easy-to-use form." (setq image-dired-widget-list nil) ;; Setup buffer. (let ((files (dired-get-marked-files))) - (switch-to-buffer "*Image-Dired Edit Meta Data*") + (pop-to-buffer-same-window "*Image-Dired Edit Meta Data*") (kill-all-local-variables) (make-local-variable 'widget-example-repeat) (let ((inhibit-read-only t)) commit 88fefc3291060f18503738aaa4e81b98f1970a55 Merge: 0fc4761 56c8178 Author: Noam Postavsky Date: Fri Dec 2 20:39:10 2016 -0500 ; Merge: Lisp watchpoints (Bug#24923) commit 56c817837bff3ffef587a9c80d619b9fe4886159 Author: Noam Postavsky Date: Sun Dec 13 14:47:58 2015 -0500 Document watchpoints * doc/lispref/debugging.texi (Variable Debugging): * doc/lispref/variables.texi (Watching Variables): New section. * etc/NEWS: Add entry for watchpoints diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 6c0908a..c80b0f9 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -69,6 +69,7 @@ debugger recursively. @xref{Recursive Editing}. * Error Debugging:: Entering the debugger when an error happens. * Infinite Loops:: Stopping and debugging a program that doesn't exit. * Function Debugging:: Entering it when a certain function is called. +* Variable Debugging:: Entering it when a variable is modified. * Explicit Debug:: Entering it at a certain point in the program. * Using Debugger:: What the debugger does; what you see while in it. * 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 not currently set up to break on entry. @end deffn +@node Variable Debugging +@subsection Entering the debugger when a variable is modified +@cindex variable write debugging +@cindex debugging changes to variables + +Sometimes a problem with a function is due to a wrong setting of a +variable. Setting up the debugger to trigger whenever the variable is +changed is a quick way to find the origin of the setting. + +@deffn Command debug-on-variable-change variable +This function arranges for the debugger to be called whenever +@var{variable} is modified. + +It is implemented using the watchpoint mechanism, so it inherits the +same characteristics and limitations: all aliases of @var{variable} +will be watched together, only dynamic variables can be watched, and +changes to the objects referenced by variables are not detected. For +details, see @ref{Watching Variables}. +@end deffn + +@deffn Command cancel-debug-on-variable-change &optional variable +This function undoes the effect of @code{debug-on-variable-change} on +@var{variable}. When called interactively, it prompts for +@var{variable} in the minibuffer. If @var{variable} is omitted or +@code{nil}, it cancels break-on-change for all variables. Calling +@code{cancel-debug-on-variable-change} does nothing to a variable +which is not currently set up to break on change. +@end deffn + + @node Explicit Debug @subsection Explicit Entry to the Debugger @cindex debugger, explicit entry diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 708bd9c..6983ab7 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -498,6 +498,7 @@ Variables * Accessing Variables:: Examining values of variables whose names are known only at run time. * Setting Variables:: Storing new values in variables. +* Watching Variables:: Running a function when a variable is changed. * Variable Scoping:: How Lisp chooses among local and global values. * Buffer-Local Variables:: Variable values in effect only in one buffer. * File Local Variables:: Handling local variable lists in files. @@ -642,6 +643,7 @@ The Lisp Debugger * Error Debugging:: Entering the debugger when an error happens. * Infinite Loops:: Stopping and debugging a program that doesn't exit. * Function Debugging:: Entering it when a certain function is called. +* Variable Debugging:: Entering it when a variable is modified. * Explicit Debug:: Entering it at a certain point in the program. * Using Debugger:: What the debugger does; what you see while in it. * Debugger Commands:: Commands used while in the debugger. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 4f2274f..d777e4d 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -34,6 +34,7 @@ representing the variable. * Accessing Variables:: Examining values of variables whose names are known only at run time. * Setting Variables:: Storing new values in variables. +* Watching Variables:: Running a function when a variable is changed. * Variable Scoping:: How Lisp chooses among local and global values. * Buffer-Local Variables:: Variable values in effect only in one buffer. * File Local Variables:: Handling local variable lists in files. @@ -766,6 +767,66 @@ error is signaled. @end example @end defun +@node Watching Variables +@section Running a function when a variable is changed. +@cindex variable watchpoints +@cindex watchpoints for Lisp variables + +It is sometimes useful to take some action when a variable changes its +value. The watchpoint facility provides the means to do so. Some +possible uses for this feature include keeping display in sync with +variable settings, and invoking the debugger to track down unexpected +changes to variables (@pxref{Variable Debugging}). + +The following functions may be used to manipulate and query the watch +functions for a variable. + +@defun add-variable-watcher symbol watch-function +This function arranges for @var{watch-function} to be called whenever +@var{symbol} is modified. Modifications through aliases +(@pxref{Variable Aliases}) will have the same effect. + +@var{watch-function} will be called with 4 arguments: (@var{symbol} +@var{newval} @var{operation} @var{where}). + +@var{symbol} is the variable being changed. +@var{newval} is the value it will be changed to. +@var{operation} is a symbol representing the kind of change, one of: +`set', `let', `unlet', `makunbound', and `defvaralias'. +@var{where} is a buffer if the buffer-local value of the variable is +being changed, nil otherwise. +@end defun + +@defun remove-variable-watch symbol watch-function +This function removes @var{watch-function} from @var{symbol}'s list of +watchers. +@end defun + +@defun get-variable-watchers symbol +This function returns the list of @var{symbol}'s active watcher +functions. +@end defun + +@subsection Limitations + +There are a couple of ways in which a variable could be modifed (or at +least appear to be modified) without triggering a watchpoint. + +Since watchpoints are attached to symbols, modification to the +objects contained within variables (e.g., by a list modification +function @pxref{Modifying Lists}) is not caught by this mechanism. + +Additionally, C code can modify the value of variables directly, +bypassing the watchpoint mechanism. + +A minor limitation of this feature, again because it targets symbols, +is that only variables of dynamic scope may be watched. This poses +little difficulty, since modifications to lexical variables can be +discovered easily by inspecting the code within the scope of the +variable (unlike dynamic variables, which can be modified by any code +at all, @pxref{Variable Scoping}). + + @node Variable Scoping @section Scoping Rules for Variable Bindings @cindex scoping rule diff --git a/etc/NEWS b/etc/NEWS index 0d2162c..f7565b0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -716,6 +716,11 @@ consistency with the new functions. For compatibility, 'sxhash' remains as an alias to 'sxhash-equal'. +++ +** New function `add-variable-watcher' can be used to call a function +when a symbol's value is changed. This is used to implement the new +debugger command `debug-on-variable-change'. + ++++ ** Time conversion functions that accept a time zone rule argument now allow it to be OFFSET or a list (OFFSET ABBR), where the integer OFFSET is a count of seconds east of Universal Time, and the string diff --git a/src/data.c b/src/data.c index 81846b5..eee2a52 100644 --- a/src/data.c +++ b/src/data.c @@ -1428,6 +1428,15 @@ harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable) DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher, 2, 2, 0, doc: /* Cause WATCH-FUNCTION to be called when SYMBOL is set. + +It will be called with 4 arguments: (SYMBOL NEWVAL OPERATION WHERE). +SYMBOL is the variable being changed. +NEWVAL is the value it will be changed to. +OPERATION is a symbol representing the kind of change, one of: `set', +`let', `unlet', `makunbound', and `defvaralias'. +WHERE is a buffer if the buffer-local value of the variable being +changed, nil otherwise. + All writes to aliases of SYMBOL will call WATCH-FUNCTION too. */) (Lisp_Object symbol, Lisp_Object watch_function) { commit e7cd98b86fc7cb7d8b187087ffff95f106124dc5 Author: Noam Postavsky Date: Sat Dec 12 23:10:15 2015 -0500 Add tests for watchpoints * test/src/data-tests.el (data-tests-variable-watchers): (data-tests-local-variable-watchers): New tests. diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 0a29233..4c2ea54 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." (v2 (test-bool-vector-bv-from-hex-string "0000C")) (v3 (bool-vector-not v1))) (should (equal v2 v3)))) + +(ert-deftest data-tests-variable-watchers () + (defvar data-tests-var 0) + (let* ((watch-data nil) + (collect-watch-data + (lambda (&rest args) (push args watch-data)))) + (cl-flet ((should-have-watch-data (data) + (should (equal (pop watch-data) data)) + (should (null watch-data)))) + (add-variable-watcher 'data-tests-var collect-watch-data) + (setq data-tests-var 1) + (should-have-watch-data '(data-tests-var 1 set nil)) + (let ((data-tests-var 2)) + (should-have-watch-data '(data-tests-var 2 let nil)) + (setq data-tests-var 3) + (should-have-watch-data '(data-tests-var 3 set nil))) + (should-have-watch-data '(data-tests-var 1 unlet nil)) + ;; `setq-default' on non-local variable is same as `setq'. + (setq-default data-tests-var 4) + (should-have-watch-data '(data-tests-var 4 set nil)) + (makunbound 'data-tests-var) + (should-have-watch-data '(data-tests-var nil makunbound nil)) + (setq data-tests-var 5) + (should-have-watch-data '(data-tests-var 5 set nil)) + (remove-variable-watcher 'data-tests-var collect-watch-data) + (setq data-tests-var 6) + (should (null watch-data))))) + +(ert-deftest data-tests-varalias-watchers () + (defvar data-tests-var0 0) + (defvar data-tests-var1 0) + (defvar data-tests-var2 0) + (defvar data-tests-var3 0) + (let* ((watch-data nil) + (collect-watch-data + (lambda (&rest args) (push args watch-data)))) + (cl-flet ((should-have-watch-data (data) + (should (equal (pop watch-data) data)) + (should (null watch-data)))) + ;; Watch var0, then alias it. + (add-variable-watcher 'data-tests-var0 collect-watch-data) + (defvaralias 'data-tests-var0-alias 'data-tests-var0) + (setq data-tests-var0 1) + (should-have-watch-data '(data-tests-var0 1 set nil)) + (setq data-tests-var0-alias 2) + (should-have-watch-data '(data-tests-var0 2 set nil)) + ;; Alias var1, then watch var1-alias. + (defvaralias 'data-tests-var1-alias 'data-tests-var1) + (add-variable-watcher 'data-tests-var1-alias collect-watch-data) + (setq data-tests-var1 1) + (should-have-watch-data '(data-tests-var1 1 set nil)) + (setq data-tests-var1-alias 2) + (should-have-watch-data '(data-tests-var1 2 set nil)) + ;; Alias var2, then watch it. + (defvaralias 'data-tests-var2-alias 'data-tests-var2) + (add-variable-watcher 'data-tests-var2 collect-watch-data) + (setq data-tests-var2 1) + (should-have-watch-data '(data-tests-var2 1 set nil)) + (setq data-tests-var2-alias 2) + (should-have-watch-data '(data-tests-var2 2 set nil)) + ;; Watch var3-alias, then make it alias var3 (this removes the + ;; watcher flag). + (defvar data-tests-var3-alias 0) + (add-variable-watcher 'data-tests-var3-alias collect-watch-data) + (defvaralias 'data-tests-var3-alias 'data-tests-var3) + (should-have-watch-data '(data-tests-var3-alias + data-tests-var3 defvaralias nil)) + (setq data-tests-var3 1) + (setq data-tests-var3-alias 2) + (should (null watch-data))))) + +(ert-deftest data-tests-local-variable-watchers () + (defvar-local data-tests-lvar 0) + (let* ((buf1 (current-buffer)) + (buf2 nil) + (watch-data nil) + (collect-watch-data + (lambda (&rest args) (push args watch-data)))) + (cl-flet ((should-have-watch-data (data) + (should (equal (pop watch-data) data)) + (should (null watch-data)))) + (add-variable-watcher 'data-tests-lvar collect-watch-data) + (setq data-tests-lvar 1) + (should-have-watch-data `(data-tests-lvar 1 set ,buf1)) + (let ((data-tests-lvar 2)) + (should-have-watch-data `(data-tests-lvar 2 let ,buf1)) + (setq data-tests-lvar 3) + (should-have-watch-data `(data-tests-lvar 3 set ,buf1))) + (should-have-watch-data `(data-tests-lvar 1 unlet ,buf1)) + (setq-default data-tests-lvar 4) + (should-have-watch-data `(data-tests-lvar 4 set nil)) + (with-temp-buffer + (setq buf2 (current-buffer)) + (setq data-tests-lvar 1) + (should-have-watch-data `(data-tests-lvar 1 set ,buf2)) + (let ((data-tests-lvar 2)) + (should-have-watch-data `(data-tests-lvar 2 let ,buf2)) + (setq data-tests-lvar 3) + (should-have-watch-data `(data-tests-lvar 3 set ,buf2))) + (should-have-watch-data `(data-tests-lvar 1 unlet ,buf2)) + (kill-local-variable 'data-tests-lvar) + (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2)) + (setq data-tests-lvar 3.5) + (should-have-watch-data `(data-tests-lvar 3.5 set ,buf2)) + (kill-all-local-variables) + (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2))) + (setq-default data-tests-lvar 4) + (should-have-watch-data `(data-tests-lvar 4 set nil)) + (makunbound 'data-tests-lvar) + (should-have-watch-data '(data-tests-lvar nil makunbound nil)) + (setq data-tests-lvar 5) + (should-have-watch-data `(data-tests-lvar 5 set ,buf1)) + (remove-variable-watcher 'data-tests-lvar collect-watch-data) + (setq data-tests-lvar 6) + (should (null watch-data))))) commit d3faef9baedadc9eaec46814ba9bbe5168048328 Author: Noam Postavsky Date: Sat Nov 21 17:02:42 2015 -0500 Ensure redisplay using variable watcher This replaces looking up the variable name in redisplay--variables when setting it. * lisp/frame.el: Replace redisplay--variables with add-variable-watcher calls. * src/xdisp.c (Fset_buffer_redisplay): Rename from maybe_set_redisplay, set the redisplay flag unconditionally. (Vredisplay__variables): Remove it. * src/data.c (set_internal): Remove maybe_set_redisplay call. diff --git a/lisp/frame.el b/lisp/frame.el index a584567..1dffc6c 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2249,9 +2249,8 @@ See also `toggle-frame-maximized'." 'window-system-version "it does not give useful information." "24.3") ;; Variables which should trigger redisplay of the current buffer. -(setq redisplay--variables (make-hash-table :test 'eq :size 10)) (mapc (lambda (var) - (puthash var 1 redisplay--variables)) + (add-variable-watcher var (symbol-function 'set-buffer-redisplay))) '(line-spacing overline-margin line-prefix diff --git a/src/data.c b/src/data.c index 095b740..81846b5 100644 --- a/src/data.c +++ b/src/data.c @@ -1275,8 +1275,6 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, default: emacs_abort (); } - maybe_set_redisplay (symbol); - start: switch (sym->redirect) { diff --git a/src/window.h b/src/window.h index a124b33..4a102f2 100644 --- a/src/window.h +++ b/src/window.h @@ -1063,7 +1063,6 @@ extern void wset_redisplay (struct window *w); extern void fset_redisplay (struct frame *f); extern void bset_redisplay (struct buffer *b); extern void bset_update_mode_line (struct buffer *b); -extern void maybe_set_redisplay (Lisp_Object); /* Call this to tell redisplay to look for other windows than selected-window that need to be redisplayed. Calling one of the *set_redisplay functions above already does it, so it's only needed in unusual cases. */ diff --git a/src/xdisp.c b/src/xdisp.c index 2acdfa9..ad0b968 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -622,15 +622,15 @@ bset_update_mode_line (struct buffer *b) b->text->redisplay = true; } -void -maybe_set_redisplay (Lisp_Object symbol) -{ - if (HASH_TABLE_P (Vredisplay__variables) - && hash_lookup (XHASH_TABLE (Vredisplay__variables), symbol, NULL) >= 0) - { - bset_update_mode_line (current_buffer); - current_buffer->prevent_redisplay_optimizations_p = true; - } +DEFUN ("set-buffer-redisplay", Fset_buffer_redisplay, + Sset_buffer_redisplay, 4, 4, 0, + doc: /* Mark the current buffer for redisplay. +This function may be passed to `add-variable-watcher'. */) + (Lisp_Object symbol, Lisp_Object newval, Lisp_Object op, Lisp_Object where) +{ + bset_update_mode_line (current_buffer); + current_buffer->prevent_redisplay_optimizations_p = true; + return Qnil; } #ifdef GLYPH_DEBUG @@ -31322,6 +31322,7 @@ They are still logged to the *Messages* buffer. */); message_dolog_marker3 = Fmake_marker (); staticpro (&message_dolog_marker3); + defsubr (&Sset_buffer_redisplay); #ifdef GLYPH_DEBUG defsubr (&Sdump_frame_glyph_matrix); defsubr (&Sdump_glyph_matrix); @@ -31991,10 +31992,6 @@ display table takes effect; in this case, Emacs does not consult doc: /* */); Vredisplay__mode_lines_cause = Fmake_hash_table (0, NULL); - DEFVAR_LISP ("redisplay--variables", Vredisplay__variables, - doc: /* A hash-table of variables changing which triggers a thorough redisplay. */); - Vredisplay__variables = Qnil; - DEFVAR_BOOL ("redisplay--inhibit-bidi", redisplay__inhibit_bidi, doc: /* Non-nil means it is not safe to attempt bidi reordering for display. */); /* Initialize to t, since we need to disable reordering until commit cfd2b9eae17754c0e109961f2880f05012a4891d Author: Noam Postavsky Date: Sat Nov 21 16:03:06 2015 -0500 Add function to trigger debugger on variable write * lisp/emacs-lisp/debug.el (debug-on-variable-change): (debug--variable-list): (cancel-debug-on-variable-change): New functions. (debugger-setup-buffer): Add watchpoint clause. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 7d27380..5430b72 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -306,6 +306,24 @@ That buffer should be current already." (delete-char 1) (insert ? ) (beginning-of-line)) + ;; Watchpoint triggered. + ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) + (insert + "--" + (pcase details + (`(makunbound nil) (format "making %s void" symbol)) + (`(makunbound ,buffer) (format "killing local value of %s in buffer %s" + symbol buffer)) + (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval)) + (`(let ,_) (format "let-binding %s to %S" symbol newval)) + (`(unlet ,_) (format "ending let-binding of %s" symbol)) + (`(set nil) (format "setting %s to %S" symbol newval)) + (`(set ,buffer) (format "setting %s in buffer %s to %S" + symbol buffer newval)) + (_ (error "unrecognized watchpoint triggered %S" (cdr args)))) + ": ") + (setq pos (point)) + (insert ?\n)) ;; Debugger entered for an error. (`error (insert "--Lisp error: ") @@ -850,6 +868,79 @@ To specify a nil argument interactively, exit with an empty minibuffer." (princ "Note: if you have redefined a function, then it may no longer\n") (princ "be set to debug on entry, even if it is in the list.")))))) +(defun debug--implement-debug-watch (symbol newval op where) + "Conditionally call the debugger. +This function is called when SYMBOL's value is modified." + (if (or inhibit-debug-on-entry debugger-jumping-flag) + nil + (let ((inhibit-debug-on-entry t)) + (funcall debugger 'watchpoint symbol newval op where)))) + +;;;###autoload +(defun debug-on-variable-change (variable) + "Trigger a debugger invocation when VARIABLE is changed. + +When called interactively, prompt for VARIABLE in the minibuffer. + +This works by calling `add-variable-watch' on VARIABLE. If you +quit from the debugger, this will abort the change (unless the +change is caused by the termination of a let-binding). + +The watchpoint may be circumvented by C code that changes the +variable directly (i.e., not via `set'). Changing the value of +the variable (e.g., `setcar' on a list variable) will not trigger +watchpoint. + +Use \\[cancel-debug-on-variable-change] to cancel the effect of +this command. Uninterning VARIABLE or making it an alias of +another symbol also cancels it." + (interactive + (let* ((var-at-point (variable-at-point)) + (var (and (symbolp var-at-point) var-at-point)) + (val (completing-read + (concat "Debug when setting variable" + (if var (format " (default %s): " var) ": ")) + obarray #'boundp + t nil nil (and var (symbol-name var))))) + (list (if (equal val "") var (intern val))))) + (add-variable-watcher variable #'debug--implement-debug-watch)) + +;;;###autoload +(defalias 'debug-watch #'debug-on-variable-change) + + +(defun debug--variable-list () + "List of variables currently set for debug on set." + (let ((vars '())) + (mapatoms + (lambda (s) + (when (memq #'debug--implement-debug-watch + (get s 'watchers)) + (push s vars)))) + vars)) + +;;;###autoload +(defun cancel-debug-on-variable-change (&optional variable) + "Undo effect of \\[debug-on-variable-change] on VARIABLE. +If VARIABLE is nil, cancel debug-on-variable-change for all variables. +When called interactively, prompt for VARIABLE in the minibuffer. +To specify a nil argument interactively, exit with an empty minibuffer." + (interactive + (list (let ((name + (completing-read + "Cancel debug on set for variable (default all variables): " + (mapcar #'symbol-name (debug--variable-list)) nil t))) + (when name + (unless (string= name "") + (intern name)))))) + (if variable + (remove-variable-watcher variable #'debug--implement-debug-watch) + (message "Canceling debug-watch for all variables") + (mapc #'cancel-debug-watch (debug--variable-list)))) + +;;;###autoload +(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change) + (provide 'debug) ;;; debug.el ends here commit 459a23444e321d25f0b82bede76947576f01ecc3 Author: Noam Postavsky Date: Sat Nov 19 16:50:34 2016 -0500 Show watchpoints when describing variables * src/data.c (Fget_variable_watchers): New function. * lisp/help-fns.el (describe-variable): Use it to detect watching functions. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 87e7d8f..23dec89 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -918,6 +918,7 @@ it is displayed along with the global value." (indirect-variable variable) (error variable))) (obsolete (get variable 'byte-obsolete-variable)) + (watchpoints (get-variable-watchers variable)) (use (car obsolete)) (safe-var (get variable 'safe-local-variable)) (doc (or (documentation-property @@ -967,6 +968,12 @@ if it is given a local binding.\n")))) (t "."))) (terpri)) + (when watchpoints + (setq extra-line t) + (princ " Calls these functions when changed: ") + (princ watchpoints) + (terpri)) + (when (member (cons variable val) (with-current-buffer buffer file-local-variables-alist)) diff --git a/src/data.c b/src/data.c index 07730d0..095b740 100644 --- a/src/data.c +++ b/src/data.c @@ -1463,6 +1463,16 @@ SYMBOL (or its aliases) are set. */) return Qnil; } +DEFUN ("get-variable-watchers", Fget_variable_watchers, Sget_variable_watchers, + 1, 1, 0, + doc: /* Return a list of SYMBOL's active watchers. */) + (Lisp_Object symbol) +{ + return (SYMBOL_TRAPPED_WRITE_P (symbol) == SYMBOL_TRAPPED_WRITE) + ? Fget (Findirect_variable (symbol), Qwatchers) + : Qnil; +} + void notify_variable_watchers (Lisp_Object symbol, Lisp_Object newval, @@ -3874,4 +3884,5 @@ syms_of_data (void) DEFSYM (Qset_default, "set-default"); defsubr (&Sadd_variable_watcher); defsubr (&Sremove_variable_watcher); + defsubr (&Sget_variable_watchers); } commit 227213164e06363f0a4fb2beeeb647c99749299e Author: Noam Postavsky Date: Thu Nov 19 19:50:06 2015 -0500 Add lisp watchpoints This allows calling a function whenever a symbol-value is changed. * src/lisp.h (lisp_h_SYMBOL_TRAPPED_WRITE_P): (SYMBOL_TRAPPED_WRITE_P): New function/macro. (lisp_h_SYMBOL_CONSTANT_P): Check for SYMBOL_NOWRITE specifically. (enum symbol_trapped_write): New enumeration. (struct Lisp_Symbol): Rename field constant to trapped_write. (make_symbol_constant): New function. * src/data.c (Fadd_variable_watcher, Fremove_variable_watcher): (set_symbol_trapped_write, restore_symbol_trapped_write): (harmonize_variable_watchers, notify_variable_watchers): New functions. * src/data.c (Fset_default): Call `notify_variable_watchers' for trapped symbols. (set_internal): Change bool argument BIND to 3-value enum and call `notify_variable_watchers' for trapped symbols. * src/data.c (syms_of_data): * src/data.c (syms_of_data): * src/font.c (syms_of_font): * src/lread.c (intern_sym, init_obarray): * src/buffer.c (syms_of_buffer): Use make_symbol_constant. * src/alloc.c (init_symbol): * src/bytecode.c (exec_byte_code): Use SYMBOL_TRAPPED_WRITE_P. * src/data.c (Fmake_variable_buffer_local, Fmake_local_variable): (Fmake_variable_frame_local): * src/eval.c (Fdefvaralias, specbind): Refer to Lisp_Symbol's trapped_write instead of constant. (Ffuncall): Move subr calling code into separate function. (funcall_subr): New function. diff --git a/src/alloc.c b/src/alloc.c index ae32400..6eced7b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3567,7 +3567,7 @@ init_symbol (Lisp_Object val, Lisp_Object name) set_symbol_next (val, NULL); p->gcmarkbit = false; p->interned = SYMBOL_UNINTERNED; - p->constant = 0; + p->trapped_write = SYMBOL_UNTRAPPED_WRITE; p->declared_special = false; p->pinned = false; } diff --git a/src/buffer.c b/src/buffer.c index aa556b7..6815aa7 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -984,40 +984,54 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too) bset_local_var_alist (b, Qnil); else { - Lisp_Object tmp, prop, last = Qnil; + Lisp_Object tmp, last = Qnil; for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp)) - if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) - { - /* If permanent-local, keep it. */ - last = tmp; - if (EQ (prop, Qpermanent_local_hook)) - { - /* This is a partially permanent hook variable. - Preserve only the elements that want to be preserved. */ - Lisp_Object list, newlist; - list = XCDR (XCAR (tmp)); - if (!CONSP (list)) - newlist = list; - else - for (newlist = Qnil; CONSP (list); list = XCDR (list)) - { - Lisp_Object elt = XCAR (list); - /* Preserve element ELT if it's t, - if it is a function with a `permanent-local-hook' property, - or if it's not a symbol. */ - if (! SYMBOLP (elt) - || EQ (elt, Qt) - || !NILP (Fget (elt, Qpermanent_local_hook))) - newlist = Fcons (elt, newlist); - } - XSETCDR (XCAR (tmp), Fnreverse (newlist)); - } - } - /* Delete this local variable. */ - else if (NILP (last)) - bset_local_var_alist (b, XCDR (tmp)); - else - XSETCDR (last, XCDR (tmp)); + { + Lisp_Object local_var = XCAR (XCAR (tmp)); + Lisp_Object prop = Fget (local_var, Qpermanent_local); + + if (!NILP (prop)) + { + /* If permanent-local, keep it. */ + last = tmp; + if (EQ (prop, Qpermanent_local_hook)) + { + /* This is a partially permanent hook variable. + Preserve only the elements that want to be preserved. */ + Lisp_Object list, newlist; + list = XCDR (XCAR (tmp)); + if (!CONSP (list)) + newlist = list; + else + for (newlist = Qnil; CONSP (list); list = XCDR (list)) + { + Lisp_Object elt = XCAR (list); + /* Preserve element ELT if it's t, + if it is a function with a `permanent-local-hook' property, + or if it's not a symbol. */ + if (! SYMBOLP (elt) + || EQ (elt, Qt) + || !NILP (Fget (elt, Qpermanent_local_hook))) + newlist = Fcons (elt, newlist); + } + newlist = Fnreverse (newlist); + if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE) + notify_variable_watchers (local_var, newlist, + Qmakunbound, Fcurrent_buffer ()); + XSETCDR (XCAR (tmp), newlist); + continue; /* Don't do variable write trapping twice. */ + } + } + /* Delete this local variable. */ + else if (NILP (last)) + bset_local_var_alist (b, XCDR (tmp)); + else + XSETCDR (last, XCDR (tmp)); + + if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE) + notify_variable_watchers (local_var, Qnil, + Qmakunbound, Fcurrent_buffer ()); + } } for (i = 0; i < last_per_buffer_idx; ++i) @@ -5541,7 +5555,7 @@ file I/O and the behavior of various editing commands. This variable is buffer-local but you cannot set it directly; use the function `set-buffer-multibyte' to change a buffer's representation. See also Info node `(elisp)Text Representations'. */); - XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1; + make_symbol_constant (intern_c_string ("enable-multibyte-characters")); DEFVAR_PER_BUFFER ("buffer-file-coding-system", &BVAR (current_buffer, buffer_file_coding_system), Qnil, diff --git a/src/bytecode.c b/src/bytecode.c index be39a81..868c014 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, if (SYMBOLP (sym) && !EQ (val, Qunbound) && !XSYMBOL (sym)->redirect - && !SYMBOL_CONSTANT_P (sym)) + && !SYMBOL_TRAPPED_WRITE_P (sym)) SET_SYMBOL_VAL (XSYMBOL (sym), val); else - set_internal (sym, val, Qnil, false); + set_internal (sym, val, Qnil, SET_INTERNAL_SET); } NEXT; diff --git a/src/data.c b/src/data.c index 61b5da8..07730d0 100644 --- a/src/data.c +++ b/src/data.c @@ -1225,7 +1225,7 @@ DEFUN ("set", Fset, Sset, 2, 2, 0, doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */) (register Lisp_Object symbol, Lisp_Object newval) { - set_internal (symbol, newval, Qnil, 0); + set_internal (symbol, newval, Qnil, SET_INTERNAL_SET); return newval; } @@ -1233,13 +1233,14 @@ DEFUN ("set", Fset, Sset, 2, 2, 0, If buffer/frame-locality is an issue, WHERE specifies which context to use. (nil stands for the current buffer/frame). - If BINDFLAG is false, then if this symbol is supposed to become - local in every buffer where it is set, then we make it local. - If BINDFLAG is true, we don't do that. */ + If BINDFLAG is SET_INTERNAL_SET, then if this symbol is supposed to + become local in every buffer where it is set, then we make it + local. If BINDFLAG is SET_INTERNAL_BIND or SET_INTERNAL_UNBIND, we + don't do that. */ void set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, - bool bindflag) + enum Set_Internal_Bind bindflag) { bool voide = EQ (newval, Qunbound); struct Lisp_Symbol *sym; @@ -1250,18 +1251,31 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, return; */ CHECK_SYMBOL (symbol); - if (SYMBOL_CONSTANT_P (symbol)) + sym = XSYMBOL (symbol); + switch (sym->trapped_write) { + case SYMBOL_NOWRITE: if (NILP (Fkeywordp (symbol)) - || !EQ (newval, Fsymbol_value (symbol))) - xsignal1 (Qsetting_constant, symbol); + || !EQ (newval, Fsymbol_value (symbol))) + xsignal1 (Qsetting_constant, symbol); else - /* Allow setting keywords to their own value. */ - return; + /* Allow setting keywords to their own value. */ + return; + + case SYMBOL_TRAPPED_WRITE: + notify_variable_watchers (symbol, voide? Qnil : newval, + (bindflag == SET_INTERNAL_BIND? Qlet : + bindflag == SET_INTERNAL_UNBIND? Qunlet : + voide? Qmakunbound : Qset), + where); + /* FALLTHROUGH! */ + case SYMBOL_UNTRAPPED_WRITE: + break; + + default: emacs_abort (); } maybe_set_redisplay (symbol); - sym = XSYMBOL (symbol); start: switch (sym->redirect) @@ -1385,6 +1399,111 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, } return; } + +static void +set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap) +{ + struct Lisp_Symbol* sym = XSYMBOL (symbol); + if (sym->trapped_write == SYMBOL_NOWRITE) + xsignal1 (Qtrapping_constant, symbol); + else if (sym->redirect == SYMBOL_LOCALIZED + && SYMBOL_BLV (sym)->frame_local) + xsignal1 (Qtrapping_frame_local, symbol); + sym->trapped_write = trap; +} + +static void +restore_symbol_trapped_write (Lisp_Object symbol) +{ + set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE); +} + +static void +harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable) +{ + if (!EQ (base_variable, alias) + && EQ (base_variable, Findirect_variable (alias))) + set_symbol_trapped_write + (alias, XSYMBOL (base_variable)->trapped_write); +} + +DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher, + 2, 2, 0, + doc: /* Cause WATCH-FUNCTION to be called when SYMBOL is set. +All writes to aliases of SYMBOL will call WATCH-FUNCTION too. */) + (Lisp_Object symbol, Lisp_Object watch_function) +{ + symbol = Findirect_variable (symbol); + set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE); + map_obarray (Vobarray, harmonize_variable_watchers, symbol); + + Lisp_Object watchers = Fget (symbol, Qwatchers); + Lisp_Object member = Fmember (watch_function, watchers); + if (NILP (member)) + Fput (symbol, Qwatchers, Fcons (watch_function, watchers)); + return Qnil; +} + +DEFUN ("remove-variable-watcher", Fremove_variable_watcher, Sremove_variable_watcher, + 2, 2, 0, + doc: /* Undo the effect of `add-variable-watcher'. +Remove WATCH-FUNCTION from the list of functions to be called when +SYMBOL (or its aliases) are set. */) + (Lisp_Object symbol, Lisp_Object watch_function) +{ + symbol = Findirect_variable (symbol); + Lisp_Object watchers = Fget (symbol, Qwatchers); + watchers = Fdelete (watch_function, watchers); + if (NILP (watchers)) + { + set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE); + map_obarray (Vobarray, harmonize_variable_watchers, symbol); + } + Fput (symbol, Qwatchers, watchers); + return Qnil; +} + +void +notify_variable_watchers (Lisp_Object symbol, + Lisp_Object newval, + Lisp_Object operation, + Lisp_Object where) +{ + symbol = Findirect_variable (symbol); + + ptrdiff_t count = SPECPDL_INDEX (); + record_unwind_protect (restore_symbol_trapped_write, symbol); + /* Avoid recursion. */ + set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE); + + if (NILP (where) + && !EQ (operation, Qset_default) && !EQ (operation, Qmakunbound) + && !NILP (Flocal_variable_if_set_p (symbol, Fcurrent_buffer ()))) + { + XSETBUFFER (where, current_buffer); + } + + if (EQ (operation, Qset_default)) + operation = Qset; + + for (Lisp_Object watchers = Fget (symbol, Qwatchers); + CONSP (watchers); + watchers = XCDR (watchers)) + { + Lisp_Object watcher = XCAR (watchers); + /* Call subr directly to avoid gc. */ + if (SUBRP (watcher)) + { + Lisp_Object args[] = { symbol, newval, operation, where }; + funcall_subr (XSUBR (watcher), ARRAYELTS (args), args); + } + else + CALLN (Ffuncall, watcher, symbol, newval, operation, where); + } + + unbind_to (count, Qnil); +} + /* Access or set a buffer-local symbol's default value. */ @@ -1471,16 +1590,27 @@ for this variable. */) struct Lisp_Symbol *sym; CHECK_SYMBOL (symbol); - if (SYMBOL_CONSTANT_P (symbol)) + sym = XSYMBOL (symbol); + switch (sym->trapped_write) { + case SYMBOL_NOWRITE: if (NILP (Fkeywordp (symbol)) - || !EQ (value, Fdefault_value (symbol))) - xsignal1 (Qsetting_constant, symbol); + || !EQ (value, Fsymbol_value (symbol))) + xsignal1 (Qsetting_constant, symbol); else - /* Allow setting keywords to their own value. */ - return value; + /* Allow setting keywords to their own value. */ + return value; + + case SYMBOL_TRAPPED_WRITE: + /* Don't notify here if we're going to call Fset anyway. */ + if (sym->redirect != SYMBOL_PLAINVAL) + notify_variable_watchers (symbol, value, Qset_default, Qnil); + /* FALLTHROUGH! */ + case SYMBOL_UNTRAPPED_WRITE: + break; + + default: emacs_abort (); } - sym = XSYMBOL (symbol); start: switch (sym->redirect) @@ -1651,7 +1781,7 @@ The function `default-value' gets the default value and `set-default' sets it. default: emacs_abort (); } - if (sym->constant) + if (SYMBOL_CONSTANT_P (variable)) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); if (!blv) @@ -1726,7 +1856,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) default: emacs_abort (); } - if (sym->constant) + if (sym->trapped_write == SYMBOL_NOWRITE) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); @@ -1838,6 +1968,9 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) default: emacs_abort (); } + if (sym->trapped_write == SYMBOL_TRAPPED_WRITE) + notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); + /* Get rid of this buffer's alist element, if any. */ XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); @@ -1920,7 +2053,7 @@ frame-local bindings). */) default: emacs_abort (); } - if (sym->constant) + if (SYMBOL_TRAPPED_WRITE_P (variable)) error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); blv = make_blv (sym, forwarded, valcontents); @@ -3465,6 +3598,8 @@ syms_of_data (void) DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection"); DEFSYM (Qvoid_variable, "void-variable"); DEFSYM (Qsetting_constant, "setting-constant"); + DEFSYM (Qtrapping_constant, "trapping-constant"); + DEFSYM (Qtrapping_frame_local, "trapping-frame-local"); DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax"); DEFSYM (Qinvalid_function, "invalid-function"); @@ -3543,6 +3678,10 @@ syms_of_data (void) PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void"); PUT_ERROR (Qsetting_constant, error_tail, "Attempt to set a constant symbol"); + PUT_ERROR (Qtrapping_constant, error_tail, + "Attempt to trap writes to a constant symbol"); + PUT_ERROR (Qtrapping_frame_local, error_tail, + "Attempt to trap writes to a frame local variable"); PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax"); PUT_ERROR (Qinvalid_function, error_tail, "Invalid function"); PUT_ERROR (Qwrong_number_of_arguments, error_tail, @@ -3721,10 +3860,18 @@ syms_of_data (void) DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, doc: /* The largest value that is representable in a Lisp integer. */); Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM); - XSYMBOL (intern_c_string ("most-positive-fixnum"))->constant = 1; + make_symbol_constant (intern_c_string ("most-positive-fixnum")); DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum, doc: /* The smallest value that is representable in a Lisp integer. */); Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); - XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; + make_symbol_constant (intern_c_string ("most-negative-fixnum")); + + DEFSYM (Qwatchers, "watchers"); + DEFSYM (Qmakunbound, "makunbound"); + DEFSYM (Qunlet, "unlet"); + DEFSYM (Qset, "set"); + DEFSYM (Qset_default, "set-default"); + defsubr (&Sadd_variable_watcher); + defsubr (&Sremove_variable_watcher); } diff --git a/src/eval.c b/src/eval.c index bbc1518..724f001 100644 --- a/src/eval.c +++ b/src/eval.c @@ -593,12 +593,12 @@ The return value is BASE-VARIABLE. */) CHECK_SYMBOL (new_alias); CHECK_SYMBOL (base_variable); - sym = XSYMBOL (new_alias); - - if (sym->constant) - /* Not sure why, but why not? */ + if (SYMBOL_CONSTANT_P (new_alias)) + /* Making it an alias effectively changes its value. */ error ("Cannot make a constant an alias"); + sym = XSYMBOL (new_alias); + switch (sym->redirect) { case SYMBOL_FORWARDED: @@ -617,8 +617,8 @@ The return value is BASE-VARIABLE. */) so that old-code that affects n_a before the aliasing is setup still works. */ if (NILP (Fboundp (base_variable))) - set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1); - + set_internal (base_variable, find_symbol_value (new_alias), + Qnil, SET_INTERNAL_BIND); { union specbinding *p; @@ -628,11 +628,14 @@ The return value is BASE-VARIABLE. */) error ("Don't know how to make a let-bound variable an alias"); } + if (sym->trapped_write == SYMBOL_TRAPPED_WRITE) + notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil); + sym->declared_special = 1; XSYMBOL (base_variable)->declared_special = 1; sym->redirect = SYMBOL_VARALIAS; SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); - sym->constant = SYMBOL_CONSTANT_P (base_variable); + sym->trapped_write = XSYMBOL (base_variable)->trapped_write; LOADHIST_ATTACH (new_alias); /* Even if docstring is nil: remove old docstring. */ Fput (new_alias, Qvariable_documentation, docstring); @@ -2645,9 +2648,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) Lisp_Object fun, original_fun; Lisp_Object funcar; ptrdiff_t numargs = nargs - 1; - Lisp_Object lisp_numargs; Lisp_Object val; - Lisp_Object *internal_args; ptrdiff_t count; QUIT; @@ -2680,86 +2681,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) fun = indirect_function (fun); if (SUBRP (fun)) - { - if (numargs < XSUBR (fun)->min_args - || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) - { - XSETFASTINT (lisp_numargs, numargs); - xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs); - } - - else if (XSUBR (fun)->max_args == UNEVALLED) - xsignal1 (Qinvalid_function, original_fun); - - else if (XSUBR (fun)->max_args == MANY) - val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); - else - { - Lisp_Object internal_argbuf[8]; - if (XSUBR (fun)->max_args > numargs) - { - eassert (XSUBR (fun)->max_args <= ARRAYELTS (internal_argbuf)); - internal_args = internal_argbuf; - memcpy (internal_args, args + 1, numargs * word_size); - memclear (internal_args + numargs, - (XSUBR (fun)->max_args - numargs) * word_size); - } - else - internal_args = args + 1; - switch (XSUBR (fun)->max_args) - { - case 0: - val = (XSUBR (fun)->function.a0 ()); - break; - case 1: - val = (XSUBR (fun)->function.a1 (internal_args[0])); - break; - case 2: - val = (XSUBR (fun)->function.a2 - (internal_args[0], internal_args[1])); - break; - case 3: - val = (XSUBR (fun)->function.a3 - (internal_args[0], internal_args[1], internal_args[2])); - break; - case 4: - val = (XSUBR (fun)->function.a4 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3])); - break; - case 5: - val = (XSUBR (fun)->function.a5 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4])); - break; - case 6: - val = (XSUBR (fun)->function.a6 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5])); - break; - case 7: - val = (XSUBR (fun)->function.a7 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5], - internal_args[6])); - break; - - case 8: - val = (XSUBR (fun)->function.a8 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5], - internal_args[6], internal_args[7])); - break; - - default: - - /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. - Until this is done, there is no way to call the function. */ - emacs_abort (); - } - } - } + val = funcall_subr (XSUBR (fun), numargs, args + 1); else if (COMPILEDP (fun)) val = funcall_lambda (fun, numargs, args + 1); else @@ -2791,6 +2713,89 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) return val; } + +/* Apply a C subroutine SUBR to the NUMARGS evaluated arguments in ARG_VECTOR + and return the result of evaluation. */ + +Lisp_Object +funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) +{ + if (numargs < subr->min_args + || (subr->max_args >= 0 && subr->max_args < numargs)) + { + Lisp_Object fun; + XSETSUBR (fun, subr); + xsignal2 (Qwrong_number_of_arguments, fun, make_number (numargs)); + } + + else if (subr->max_args == UNEVALLED) + { + Lisp_Object fun; + XSETSUBR (fun, subr); + xsignal1 (Qinvalid_function, fun); + } + + else if (subr->max_args == MANY) + return (subr->function.aMANY) (numargs, args); + else + { + Lisp_Object internal_argbuf[8]; + Lisp_Object *internal_args; + if (subr->max_args > numargs) + { + eassert (subr->max_args <= ARRAYELTS (internal_argbuf)); + internal_args = internal_argbuf; + memcpy (internal_args, args, numargs * word_size); + memclear (internal_args + numargs, + (subr->max_args - numargs) * word_size); + } + else + internal_args = args; + switch (subr->max_args) + { + case 0: + return (subr->function.a0 ()); + case 1: + return (subr->function.a1 (internal_args[0])); + case 2: + return (subr->function.a2 + (internal_args[0], internal_args[1])); + case 3: + return (subr->function.a3 + (internal_args[0], internal_args[1], internal_args[2])); + case 4: + return (subr->function.a4 + (internal_args[0], internal_args[1], internal_args[2], + internal_args[3])); + case 5: + return (subr->function.a5 + (internal_args[0], internal_args[1], internal_args[2], + internal_args[3], internal_args[4])); + case 6: + return (subr->function.a6 + (internal_args[0], internal_args[1], internal_args[2], + internal_args[3], internal_args[4], internal_args[5])); + case 7: + return (subr->function.a7 + (internal_args[0], internal_args[1], internal_args[2], + internal_args[3], internal_args[4], internal_args[5], + internal_args[6])); + case 8: + return (subr->function.a8 + (internal_args[0], internal_args[1], internal_args[2], + internal_args[3], internal_args[4], internal_args[5], + internal_args[6], internal_args[7])); + + default: + + /* If a subr takes more than 8 arguments without using MANY + or UNEVALLED, we need to extend this function to support it. + Until this is done, there is no way to call the function. */ + emacs_abort (); + } + } +} + static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) { @@ -3171,10 +3176,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); grow_specpdl (); - if (!sym->constant) + if (!sym->trapped_write) SET_SYMBOL_VAL (sym, value); else - set_internal (symbol, value, Qnil, 1); + set_internal (symbol, value, Qnil, SET_INTERNAL_BIND); break; case SYMBOL_LOCALIZED: if (SYMBOL_BLV (sym)->frame_local) @@ -3214,7 +3219,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.kind = SPECPDL_LET; grow_specpdl (); - set_internal (symbol, value, Qnil, 1); + set_internal (symbol, value, Qnil, SET_INTERNAL_BIND); break; } default: emacs_abort (); @@ -3341,14 +3346,16 @@ unbind_to (ptrdiff_t count, Lisp_Object value) case SPECPDL_BACKTRACE: break; case SPECPDL_LET: - { /* If variable has a trivial value (no forwarding), we can - just set it. No need to check for constant symbols here, - since that was already done by specbind. */ + { /* If variable has a trivial value (no forwarding), and + isn't trapped, we can just set it. */ Lisp_Object sym = specpdl_symbol (specpdl_ptr); if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL) { - SET_SYMBOL_VAL (XSYMBOL (sym), - specpdl_old_value (specpdl_ptr)); + if (XSYMBOL (sym)->trapped_write == SYMBOL_UNTRAPPED_WRITE) + SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (specpdl_ptr)); + else + set_internal (sym, specpdl_old_value (specpdl_ptr), + Qnil, SET_INTERNAL_UNBIND); break; } else @@ -3371,7 +3378,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value) /* If this was a local binding, reset the value in the appropriate buffer, but only if that buffer's binding still exists. */ if (!NILP (Flocal_variable_p (symbol, where))) - set_internal (symbol, old_value, where, 1); + set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND); } break; } @@ -3596,7 +3603,7 @@ backtrace_eval_unrewind (int distance) { set_specpdl_old_value (tmp, Fbuffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, 1); + set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND); } } break; @@ -3940,6 +3947,7 @@ alist of active lexical bindings. */); defsubr (&Sset_default_toplevel_value); defsubr (&Sdefvar); defsubr (&Sdefvaralias); + DEFSYM (Qdefvaralias, "defvaralias"); defsubr (&Sdefconst); defsubr (&Smake_var_non_special); defsubr (&Slet); diff --git a/src/font.c b/src/font.c index 9fe7c26..36e7166 100644 --- a/src/font.c +++ b/src/font.c @@ -5415,19 +5415,19 @@ Each element has the form: [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...] NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */); Vfont_weight_table = BUILD_STYLE_TABLE (weight_table); - XSYMBOL (intern_c_string ("font-weight-table"))->constant = 1; + make_symbol_constant (intern_c_string ("font-weight-table")); DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table, doc: /* Vector of font slant symbols vs the corresponding numeric values. See `font-weight-table' for the format of the vector. */); Vfont_slant_table = BUILD_STYLE_TABLE (slant_table); - XSYMBOL (intern_c_string ("font-slant-table"))->constant = 1; + make_symbol_constant (intern_c_string ("font-slant-table")); DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table, doc: /* Alist of font width symbols vs the corresponding numeric values. See `font-weight-table' for the format of the vector. */); Vfont_width_table = BUILD_STYLE_TABLE (width_table); - XSYMBOL (intern_c_string ("font-width-table"))->constant = 1; + make_symbol_constant (intern_c_string ("font-width-table")); staticpro (&font_style_table); font_style_table = make_uninit_vector (3); diff --git a/src/lisp.h b/src/lisp.h index b6c4668..94f1152 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -320,7 +320,8 @@ error !; #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) +#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->trapped_write == SYMBOL_NOWRITE) +#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) @@ -375,6 +376,7 @@ error !; # define NILP(x) lisp_h_NILP (x) # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) +# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) # define SYMBOLP(x) lisp_h_SYMBOLP (x) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) @@ -600,6 +602,9 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); +extern void notify_variable_watchers (Lisp_Object symbol, Lisp_Object newval, + Lisp_Object operation, Lisp_Object where); + #ifdef CANNOT_DUMP enum { might_dump = false }; @@ -632,6 +637,13 @@ enum symbol_redirect SYMBOL_FORWARDED = 3 }; +enum symbol_trapped_write +{ + SYMBOL_UNTRAPPED_WRITE = 0, + SYMBOL_NOWRITE = 1, + SYMBOL_TRAPPED_WRITE = 2 +}; + struct Lisp_Symbol { bool_bf gcmarkbit : 1; @@ -643,10 +655,10 @@ struct Lisp_Symbol 3 : it's a forwarding variable, the value is in `forward'. */ ENUM_BF (symbol_redirect) redirect : 3; - /* Non-zero means symbol is constant, i.e. changing its value - should signal an error. If the value is 3, then the var - can be changed, but only by `defconst'. */ - unsigned constant : 2; + /* 0 : normal case, just set the value + 1 : constant, cannot set, e.g. nil, t, :keywords. + 2 : trap the write, call watcher functions. */ + ENUM_BF (symbol_trapped_write) trapped_write : 2; /* Interned state of the symbol. This is an enumerator from enum symbol_interned. */ @@ -1850,9 +1862,20 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; } -/* Value is non-zero if symbol is considered a constant, i.e. its - value cannot be changed (there is an exception for keyword symbols, - whose value can be set to the keyword symbol itself). */ +/* Value is non-zero if symbol cannot be changed through a simple set, + i.e. it's a constant (e.g. nil, t, :keywords), or it has some + watching functions. */ + +INLINE int +(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym) +{ + return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym); +} + +/* Value is non-zero if symbol cannot be changed at all, i.e. it's a + constant (e.g. nil, t, :keywords). Code that actually wants to + write to SYM, should also check whether there are any watching + functions. */ INLINE int (SYMBOL_CONSTANT_P) (Lisp_Object sym) @@ -3286,6 +3309,12 @@ set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next) XSYMBOL (sym)->next = next; } +INLINE void +make_symbol_constant (Lisp_Object sym) +{ + XSYMBOL (sym)->trapped_write = SYMBOL_NOWRITE; +} + /* Buffer-local (also frame-local) variable access functions. */ INLINE int @@ -3394,7 +3423,13 @@ extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); -extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool); +enum Set_Internal_Bind { + SET_INTERNAL_SET, + SET_INTERNAL_BIND, + SET_INTERNAL_UNBIND +}; +extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, + enum Set_Internal_Bind); extern void syms_of_data (void); extern void swap_in_global_binding (struct Lisp_Symbol *); @@ -3877,6 +3912,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void signal_error (const char *, Lisp_Object); +extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); extern Lisp_Object eval_sub (Lisp_Object form); extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); extern Lisp_Object call0 (Lisp_Object); diff --git a/src/lread.c b/src/lread.c index eab9b8b..14f9393 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3833,7 +3833,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) { - XSYMBOL (sym)->constant = 1; + make_symbol_constant (sym); XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (XSYMBOL (sym), sym); } @@ -4120,12 +4120,12 @@ init_obarray (void) DEFSYM (Qnil, "nil"); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); - XSYMBOL (Qnil)->constant = 1; + make_symbol_constant (Qnil); XSYMBOL (Qnil)->declared_special = true; DEFSYM (Qt, "t"); SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); - XSYMBOL (Qt)->constant = 1; + make_symbol_constant (Qt); XSYMBOL (Qt)->declared_special = true; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ commit 0fc4761ca88175c30da7209c9ab1cde788b66a76 Author: Eli Zaretskii Date: Fri Dec 2 20:37:44 2016 +0200 ; * lisp/dired-x.el (dired-omit-case-fold): Fix last change. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index a3034d1..88caca4 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -122,7 +122,7 @@ If nil, there is no maximum size." (defcustom dired-omit-case-fold 'filesystem "Determine whether \"omitting\" patterns are case-sensitive. When nil, always be case-sensitive; when t, always be -case-insensitive; the default value, 'filesystem, causes case +case-insensitive; the default value, `filesystem', causes case folding to be used on case-insensitive filesystems only." :type '(choice (const :tag "Always case-sensitive" nil) (const :tag "Always case-insensitive" t) commit 30dc85c63bd52acf7d8f4eef78e788b1816ab77b Author: Glenn Morris Date: Fri Dec 2 13:11:53 2016 -0500 Starting doc of user options with "*" is long obsolete * lisp/battery.el (battery-upower-device): Doc fix. diff --git a/lisp/battery.el b/lisp/battery.el index 773ab0d..74f06e8 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -46,7 +46,7 @@ :group 'battery) (defcustom battery-upower-device "battery_BAT1" - "*Upower battery device name." + "Upower battery device name." :version "26.1" :type 'string :group 'battery) commit 5315275f849d664ff4b5124ef9411a2c16114fd9 Author: Reuben Thomas Date: Fri Dec 2 16:36:43 2016 +0000 Fix docstrings to have a complete sentence in first line * lisp/dired-x.el (dired-omit-case-fold, dired-omit-case-fold-p): Fix docstrings. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 1a844ae..a3034d1 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -120,11 +120,10 @@ If nil, there is no maximum size." :group 'dired-x) (defcustom dired-omit-case-fold 'filesystem - "Determine whether `dired-omit-mode' will use case-folding to -match the regexp of files to omit. When nil, always be -case-sensitive; when t, always be case-insensitive; the default -value, 'filesystem, causes case folding to be used on -case-insensitive filesystems only." + "Determine whether \"omitting\" patterns are case-sensitive. +When nil, always be case-sensitive; when t, always be +case-insensitive; the default value, 'filesystem, causes case +folding to be used on case-insensitive filesystems only." :type '(choice (const :tag "Always case-sensitive" nil) (const :tag "Always case-insensitive" t) (const :tag "According to filesystem" filesystem)) @@ -132,9 +131,7 @@ case-insensitive filesystems only." :version "26.1") (defun dired-omit-case-fold-p (dir) - "Return t if, according to `dired-omit-case-fold', - `dired-omit-mode' should use case folding to interpret its - regexp in directory DIR, or nil otherwise." + "Non-nil if `dired-omit-mode' should be case-insensitive in DIR." (if (eq dired-omit-case-fold 'filesystem) (file-name-case-sensitive-p dir) dired-omit-case-fold)) commit 9effa4bfebdb9d78339997253916602afbdc6b37 Author: Reuben Thomas Date: Tue Nov 8 22:04:52 2016 +0000 Remove obsolete comments and commented code from dired-x.el * lisp/dired-x.el (dired-mark-sexp): Remove a query from 1993 and its 1997 answer about whether dired-mark-sexp is used. * lisp/dired-x.el (dired-buffers-for-dir-exact): Remove this function commented out since before dired-x.el was added to RCS in 1994. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 2bebb69..1a844ae 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1400,29 +1400,6 @@ Considers buffers closer to the car of `buffer-list' to be more recent." (memq buffer1 (buffer-list)) (not (memq buffer1 (memq buffer2 (buffer-list)))))) -;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 -;; (defun dired-buffers-for-dir-exact (dir) -;; ;; Return a list of buffers that dired DIR (a directory or wildcard) -;; ;; at top level, or as subdirectory. -;; ;; Top level matches must match the wildcard part too, if any. -;; ;; The list is in reverse order of buffer creation, most recent last. -;; ;; As a side effect, killed dired buffers for DIR are removed from -;; ;; dired-buffers. -;; (let ((alist dired-buffers) result elt) -;; (while alist -;; (setq elt (car alist) -;; alist (cdr alist)) -;; (let ((buf (cdr elt))) -;; (if (buffer-name buf) -;; ;; Top level must match exactly against dired-directory in -;; ;; case one of them is a wildcard. -;; (if (or (equal dir (with-current-buffer buf dired-directory)) -;; (assoc dir (with-current-buffer buf dired-subdir-alist))) -;; (setq result (cons buf result))) -;; ;; else buffer is killed - clean up: -;; (setq dired-buffers (delq elt dired-buffers))))) -;; result)) - ;; Needed if ls -lh is supported and also for GNU ls -ls. (defun dired-x--string-to-number (str) @@ -1440,9 +1417,6 @@ sure that a trailing letter in STR is one of BKkMGTPEZY." (setq val (* 1024.0 val))))) val)) -;; Does anyone use this? - lrd 6/29/93. -;; Apparently people do use it. - lrd 12/22/97. - (defun dired-mark-sexp (predicate &optional unflag-p) "Mark files for which PREDICATE returns non-nil. With a prefix arg, unmark or unflag those files instead. commit e22cca7d23eb9e91b2923cbdad8042e4a4c69811 Author: Reuben Thomas Date: Tue Nov 8 22:01:59 2016 +0000 Remove pre-customize dired-x.el documentation * lisp/dired-x.el (Commentary): Remove USAGE section explaining how to use dired-x from .emacs. It is now fully customizable. * lisp/dired-x.el (dired-guess-shell-alist-user): Remove explanation of how to set this custom variable in .emacs. It should be customized. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 5a0d883..2bebb69 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -29,20 +29,6 @@ ;; This is based on Sebastian Kremer's excellent dired-x.el (Dired Extra), ;; version 1.191, adapted for GNU Emacs. See the `dired-x' info pages. -;; USAGE: In your ~/.emacs, -;; -;; (add-hook 'dired-load-hook -;; (lambda () -;; (load "dired-x") -;; ;; Set global variables here. For example: -;; ;; (setq dired-guess-shell-gnutar "gtar") -;; )) -;; (add-hook 'dired-mode-hook -;; (lambda () -;; ;; Set buffer-local variables here. For example: -;; ;; (dired-omit-mode 1) -;; )) -;; ;; At load time dired-x.el will install itself and bind some dired keys. ;; Some dired.el and dired-aux.el functions have extra features if ;; dired-x is loaded. @@ -1106,17 +1092,7 @@ and the rest will be added temporarily to the history and can be retrieved with \\[previous-history-element] (M-p) . The variable `dired-guess-shell-case-fold-search' controls whether -REGEXP is matched case-sensitively. - -You can set this variable in your ~/.emacs. For example, to add rules for -`.foo' and `.bar' files, write - - (setq dired-guess-shell-alist-user - '((\"\\\\.foo\\\\'\" \"FOO-COMMAND\") - (\"\\\\.bar\\\\'\" - (if condition - \"BAR-COMMAND-1\" - \"BAR-COMMAND-2\"))))" +REGEXP is matched case-sensitively." :group 'dired-x :type '(alist :key-type regexp :value-type (repeat sexp))) commit 50b9ddfc132ead94a932e55ac39211b483109592 Author: Reuben Thomas Date: Tue Nov 8 17:42:24 2016 +0000 Allow files to be matched case-sensitively in dired-x * lisp/dired-x.el (dired-mark-unmarked-files): Add an argument which controls case folding for matching the regex (Bug#18716). (dired-omit-case-fold): New variable. Defaults to `t' on case-sensitive systems, `nil' otherwise. (dired-mark-omitted, dired-omit-expunge): Use dired-omit-case-fold. * doc/misc/dired-x.texi, etc/NEWS: Document dired-omit-case-fold. diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index db01896..7ac5bc6 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -369,6 +369,18 @@ and @code{dired-texinfo-unclean-extensions}. If non-@code{nil}, a list of extensions (strings) to omit from Dired listings. Its format is the same as that of @code{completion-ignored-extensions}. +@vindex dired-omit-case-fold +@item dired-omit-case-fold + +Default: @code{filesystem} + +By default, when @code{dired-omit-case-fold} is set to @code{filesystem}, +@code{dired-omit-mode} will match filenames and extensions +case-sensitively on Dired buffers visiting case-sensitive filesystems, +and case-insensitively on case-insensitive filesystems. Set it to +@code{nil} to be always case-sensitive, and to @code{t} to be always +case-insensitive. + @vindex dired-omit-localp @item dired-omit-localp diff --git a/etc/NEWS b/etc/NEWS index cbce027..0d2162c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -83,6 +83,12 @@ of curved quotes for 'electric-quote-mode', allowing user to choose the types of quotes to be used. +++ +** The new user variable 'dired-omit-case-fold' allows the user to +customize the case-sensitivity of dired-omit-mode. It defaults to +the same sensitivity as that of the filesystem for the corresponding +dired buffer. + ++++ ** Emacs now uses double buffering to reduce flicker when editing and resizing graphical Emacs frames on the X Window System. This support requires the DOUBLE-BUFFER extension, which major X servers have diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 8313905..5a0d883 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -133,6 +133,26 @@ If nil, there is no maximum size." :type '(choice (const :tag "no maximum" nil) integer) :group 'dired-x) +(defcustom dired-omit-case-fold 'filesystem + "Determine whether `dired-omit-mode' will use case-folding to +match the regexp of files to omit. When nil, always be +case-sensitive; when t, always be case-insensitive; the default +value, 'filesystem, causes case folding to be used on +case-insensitive filesystems only." + :type '(choice (const :tag "Always case-sensitive" nil) + (const :tag "Always case-insensitive" t) + (const :tag "According to filesystem" filesystem)) + :group 'dired-x + :version "26.1") + +(defun dired-omit-case-fold-p (dir) + "Return t if, according to `dired-omit-case-fold', + `dired-omit-mode' should use case folding to interpret its + regexp in directory DIR, or nil otherwise." + (if (eq dired-omit-case-fold 'filesystem) + (file-name-case-sensitive-p dir) + dired-omit-case-fold)) + ;; For backward compatibility (define-obsolete-variable-alias 'dired-omit-files-p 'dired-omit-mode "22.1") (define-minor-mode dired-omit-mode @@ -507,7 +527,8 @@ Should never be used as marker by the user or other packages.") "Mark files matching `dired-omit-files' and `dired-omit-extensions'." (interactive) (let ((dired-omit-mode nil)) (revert-buffer)) ;; Show omitted files - (dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp)) + (dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp + (dired-omit-case-fold-p dired-directory))) (defcustom dired-omit-extensions (append completion-ignored-extensions @@ -551,7 +572,8 @@ This functions works by temporarily binding `dired-marker-char' to (or (string= omit-re "") (let ((dired-marker-char dired-omit-marker-char)) (when dired-omit-verbose (message "Omitting...")) - (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp) + (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp + (dired-omit-case-fold-p dired-directory)) (progn (setq count (dired-do-kill-lines nil @@ -577,12 +599,14 @@ This functions works by temporarily binding `dired-marker-char' to ""))) ;; Returns t if any work was done, nil otherwise. -(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp) +(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp case-fold-p) "Mark unmarked files matching REGEXP, displaying MSG. REGEXP is matched against the entire file name. When called interactively, prompt for REGEXP. With prefix argument, unflag all those files. -Optional fourth argument LOCALP is as in `dired-get-filename'." +Optional fourth argument LOCALP is as in `dired-get-filename'. +Optional fifth argument CASE-FOLD-P specifies the value of +`case-fold-search' used for matching REGEXP." (interactive (list (read-regexp "Mark unmarked files matching regexp (default all): " @@ -594,7 +618,10 @@ Optional fourth argument LOCALP is as in `dired-get-filename'." ;; not already marked (looking-at-p " ") ;; uninteresting - (let ((fn (dired-get-filename localp t))) + (let ((fn (dired-get-filename localp t)) + ;; Match patterns case-insensitively on case-insensitive + ;; systems + (case-fold-search case-fold-p)) (and fn (string-match-p regexp fn)))) msg))) commit b6a8025eed3349ef98701ef07fa47e4abf22d1cc Author: Reuben Thomas Date: Tue Nov 8 11:53:20 2016 +0000 Add support for curly quotation marks to electric-pair-mode * lisp/elec-pair.el (electric-pair-pairs, electric-pair-text-pairs): Add entries for left/right single/double quotation marks, from electric-quote-chars. Note that this is safe for single quotation marks, unlike with the ASCII apostrophe, since, although the right quotation mark can be used as an apostrophe, it is the left quotation mark that is typed to get a pair (Bug#24901). diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 1162920..47d44b1 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -28,7 +28,9 @@ ;;; Electric pairing. (defcustom electric-pair-pairs - '((?\" . ?\")) + '((?\" . ?\") + ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars)) + ((nth 2 electric-quote-chars) . (nth 3 electric-quote-chars))) "Alist of pairs that should be used regardless of major mode. Pairs of delimiters in this list are a fallback in case they have @@ -42,7 +44,9 @@ See also the variable `electric-pair-text-pairs'." ;;;###autoload (defcustom electric-pair-text-pairs - '((?\" . ?\" )) + '((?\" . ?\" ) + ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars)) + ((nth 2 electric-quote-chars) . (nth 3 electric-quote-chars))) "Alist of pairs that should always be used in comments and strings. Pairs of delimiters in this list are a fallback in case they have commit 66d6e7e9ecf5e481f8c2c3a4f88411f66c869a6e Author: Nicolas Petton Date: Fri Dec 2 14:07:41 2016 +0100 Fix bug#25087 * etc/themes/manoj-dark-theme.el: Fix two typos. diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index 549d11b..a8b922d 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -91,8 +91,8 @@ jarring angry fruit salad look to reduce eye fatigue.") '(font-lock-doc-string-face ((t (:foreground "Plum")))) '(font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) - '(cperl-array-face ((t (:foreground "LawnGreen" :background "B;ack" :bold t)))) - '(cperl-hash-face ((t (:foreground "SpringGreen" :background "B;ack" :bold t :italic t)))) + '(cperl-array-face ((t (:foreground "LawnGreen" :background "Black" :bold t)))) + '(cperl-hash-face ((t (:foreground "SpringGreen" :background "Black" :bold t :italic t)))) '(cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) '(gnus-button ((t (:bold t :weight bold :background "#191932" :box (:line-width 2 :style released-button))))) commit e9ac4b4c82a5698e9399deea2d6450890b8baf64 Author: Michael Albinus Date: Fri Dec 2 11:38:19 2016 +0100 Handle quoted file names in Tramp * lisp/net/tramp.el (tramp-file-name-handler): Handle also the case the file name is quoted. This is not trapped by the reassigned `tramp-file-name-regexp' anymore. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index af08cf7..956cf15 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2021,20 +2021,19 @@ ARGS are the arguments OPERATION has been called with." (defun tramp-file-name-handler (operation &rest args) "Invoke Tramp file name handler. Falls back to normal file name handler if no Tramp file name handler exists." - (if tramp-mode - (save-match-data - (let* ((filename - (tramp-replace-environment-variables - (apply 'tramp-file-name-for-operation operation args))) - (completion (tramp-completion-mode-p)) - (foreign - (tramp-find-foreign-file-name-handler - filename operation completion)) - result) - (with-parsed-tramp-file-name filename nil - ;; Call the backend function. - (if foreign - (tramp-condition-case-unless-debug err + (let ((filename (apply 'tramp-file-name-for-operation operation args))) + (if (and tramp-mode (tramp-tramp-file-p filename)) + (save-match-data + (let* ((filename (tramp-replace-environment-variables filename)) + (completion (tramp-completion-mode-p)) + (foreign + (tramp-find-foreign-file-name-handler + filename operation completion)) + result) + (with-parsed-tramp-file-name filename nil + ;; Call the backend function. + (if foreign + (tramp-condition-case-unless-debug err (let ((sf (symbol-function foreign))) ;; Some packages set the default directory to a ;; remote path, before respective Tramp packages @@ -2072,43 +2071,44 @@ Falls back to normal file name handler if no Tramp file name handler exists." (tramp-run-real-handler operation args))) (t result))) - ;; Trace that somebody has interrupted the operation. - ((debug quit) - (let (tramp-message-show-message) - (tramp-message - v 1 "Interrupt received in operation %s" - (cons operation args))) - ;; Propagate the quit signal. - (signal (car err) (cdr err))) - - ;; When we are in completion mode, some failed - ;; operations shall return at least a default value - ;; in order to give the user a chance to correct the - ;; file name in the minibuffer. - ;; In order to get a full backtrace, one could apply - ;; (setq tramp-debug-on-error t) - (error - (cond - ((and completion (zerop (length localname)) - (memq operation '(file-exists-p file-directory-p))) - t) - ((and completion (zerop (length localname)) - (memq operation - '(expand-file-name file-name-as-directory))) - filename) - ;; Propagate the error. - (t (signal (car err) (cdr err)))))) - - ;; Nothing to do for us. However, since we are in - ;; `tramp-mode', we must suppress the volume letter on - ;; MS Windows. - (setq result (tramp-run-real-handler operation args)) - (if (stringp result) - (tramp-drop-volume-letter result) - result))))) - - ;; When `tramp-mode' is not enabled, we don't do anything. - (tramp-run-real-handler operation args))) + ;; Trace that somebody has interrupted the operation. + ((debug quit) + (let (tramp-message-show-message) + (tramp-message + v 1 "Interrupt received in operation %s" + (cons operation args))) + ;; Propagate the quit signal. + (signal (car err) (cdr err))) + + ;; When we are in completion mode, some failed + ;; operations shall return at least a default + ;; value in order to give the user a chance to + ;; correct the file name in the minibuffer. + ;; In order to get a full backtrace, one could apply + ;; (setq tramp-debug-on-error t) + (error + (cond + ((and completion (zerop (length localname)) + (memq operation '(file-exists-p file-directory-p))) + t) + ((and completion (zerop (length localname)) + (memq operation + '(expand-file-name file-name-as-directory))) + filename) + ;; Propagate the error. + (t (signal (car err) (cdr err)))))) + + ;; Nothing to do for us. However, since we are in + ;; `tramp-mode', we must suppress the volume letter on + ;; MS Windows. + (setq result (tramp-run-real-handler operation args)) + (if (stringp result) + (tramp-drop-volume-letter result) + result))))) + + ;; When `tramp-mode' is not enabled, or the file name is quoted, + ;; we don't do anything. + (tramp-run-real-handler operation args)))) ;; In Emacs, there is some concurrency due to timers. If a timer ;; interrupts Tramp and wishes to use the same connection buffer as commit 05a969265cabdf361492ed471f1a8dc369840401 Author: Evgeny Zajcev Date: Fri Dec 2 12:17:38 2016 +0200 * lisp/battery.el: Add 'battery-upower' -- very fast battery status. diff --git a/lisp/battery.el b/lisp/battery.el index 24eb8a5..773ab0d 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -45,6 +45,12 @@ :type 'regexp :group 'battery) +(defcustom battery-upower-device "battery_BAT1" + "*Upower battery device name." + :version "26.1" + :type 'string + :group 'battery) + (defcustom battery-status-function (cond ((and (eq system-type 'gnu/linux) (file-readable-p "/proc/apm")) @@ -536,6 +542,69 @@ The following %-sequences are provided: (t "N/A")))))) +;;; `upowerd' interface. +(defsubst battery-upower-prop (pname &optional device) + (dbus-get-property + :system + "org.freedesktop.UPower" + (concat "/org/freedesktop/UPower/devices/" (or device battery-upower-device)) + "org.freedesktop.UPower" + pname)) + +(defun battery-upower () + "Get battery status from dbus Upower interface. +This function works only in systems with `upowerd' daemon +running. + +The following %-sequences are provided: +%c Current capacity (mWh) +%p Battery load percentage +%r Current rate +%B Battery status (verbose) +%L AC line status (verbose) +%s Remaining time (to charge or discharge) in seconds +%m Remaining time (to charge or discharge) in minutes +%h Remaining time (to charge or discharge) in hours +%t Remaining time (to charge or discharge) in the form `h:min'" + (let ((percents (battery-upower-prop "Percentage")) + (time-to-empty (battery-upower-prop "TimeToEmpty")) + (time-to-full (battery-upower-prop "TimeToFull")) + (state (battery-upower-prop "State")) + (online (battery-upower-prop "Online" "line_power_ACAD")) + (energy (battery-upower-prop "Energy")) + (energy-rate (battery-upower-prop "EnergyRate")) + (battery-states '((0 . "unknown") (1 . "charging") + (2 . "discharging") (3 . "empty") + (4 . "fully-charged") (5 . "pending-charge") + (6 . "pending-discharge"))) + seconds minutes hours remaining-time) + (cond ((and online time-to-full) + (setq seconds time-to-full)) + ((and (not online) time-to-empty) + (setq seconds time-to-empty))) + (when seconds + (setq minutes (/ seconds 60) + hours (/ minutes 60) + remaining-time + (format "%d:%02d" (truncate hours) + (- (truncate minutes) (* 60 (truncate hours)))))) + (list (cons ?c (or (and energy + (number-to-string (round (* 1000 energy)))) + "N/A")) + (cons ?p (or (and percents (number-to-string (round percents))) + "N/A")) + (cons ?r (or (and energy-rate + (concat (number-to-string energy-rate) " W")) + "N/A")) + (cons ?B (or (and state (cdr (assoc state battery-states))) + "unknown")) + (cons ?L (or (and online "on-line") "off-line")) + (cons ?s (or (and seconds (number-to-string seconds)) "N/A")) + (cons ?m (or (and minutes (number-to-string minutes)) "N/A")) + (cons ?h (or (and hours (number-to-string hours)) "N/A")) + (cons ?t (or remaining-time "N/A"))))) + + ;;; `apm' interface for BSD. (defun battery-bsd-apm () "Get APM status information from BSD apm binary. commit 0b3f8ca863e7df08e79a935946f7190e595cae2b Author: Evgeny Zajcev Date: Fri Dec 2 12:09:31 2016 +0200 Support for rawrgb images using imagemagick * src/image.c (imagemagick_load_image): Set wand size before loading blob when ':width' and ':height' are provided. * lisp/image.el (image-format-suffixes): Add 'image/x-rgb'. diff --git a/lisp/image.el b/lisp/image.el index 82e0162..c34db68 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -102,7 +102,7 @@ AUTODETECT can be (see `image-type-available-p').") (defvar image-format-suffixes - '((image/x-icon "ico")) + '((image/x-rgb "rgb") (image/x-icon "ico")) "An alist associating image types with file name suffixes. This is used as a hint by the ImageMagick library when detecting the type of image data (that does not have an associated file name). diff --git a/src/image.c b/src/image.c index b5b713c..a87dc4d 100644 --- a/src/image.c +++ b/src/image.c @@ -8540,6 +8540,14 @@ imagemagick_load_image (struct frame *f, struct image *img, status = MagickReadImage (image_wand, filename); else { + Lisp_Object lwidth = image_spec_value (img->spec, QCwidth, NULL); + Lisp_Object lheight = image_spec_value (img->spec, QCheight, NULL); + + if (NATNUMP (lwidth) && NATNUMP (lheight)) + { + MagickSetSize (image_wand, XFASTINT (lwidth), XFASTINT (lheight)); + MagickSetDepth (image_wand, 8); + } filename_hint = imagemagick_filename_hint (img->spec, hint_buffer); MagickSetFilename (image_wand, filename_hint); status = MagickReadImageBlob (image_wand, contents, size); commit b3ff982a99a2fc330677b13884f9723912668e06 Author: Nikolay Kudryavtsev Date: Fri Dec 2 11:53:33 2016 +0200 Fix 'sql-connect' on first invocation * lisp/progmodes/sql.el (sql-connect): Reorder code which sets param-var. (Bug#19452) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 4d0bed7..9608a7d 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4052,6 +4052,12 @@ is specified in the connection settings." (if connect-set ;; Set the desired parameters (let (param-var login-params set-params rem-params) + ;; Set the parameters and start the interactive session + (mapc + (lambda (vv) + (set-default (car vv) (eval (cadr vv)))) + (cdr connect-set)) + (setq-default sql-connection connection) ;; :sqli-login params variable (setq param-var @@ -4081,13 +4087,6 @@ is specified in the connection settings." (unless (member token set-params) (if plist (cons token plist) token))))) - ;; Set the parameters and start the interactive session - (mapc - (lambda (vv) - (set-default (car vv) (eval (cadr vv)))) - (cdr connect-set)) - (setq-default sql-connection connection) - ;; Start the SQLi session with revised list of login parameters (eval `(let ((,param-var ',rem-params)) (sql-product-interactive ',sql-product ',new-name))))