commit f658b955ccf256d83917c9f94bdfee36b84105bf (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Aug 21 11:17:09 2021 +0300 Improve doc string of 'M-.' * lisp/progmodes/xref.el (xref-find-definitions): Mention 'M-,' in the doc string. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b6ad485407..21f4abfccf 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1309,7 +1309,9 @@ prompt for it. If sufficient information is available to determine a unique definition for IDENTIFIER, display it in the selected window. Otherwise, display the list of the possible definitions in a -buffer where the user can select from the list." +buffer where the user can select from the list. + +Use \\[xref-pop-marker-stack] to return back to where you invoked this command." (interactive (list (xref--read-identifier "Find definitions of: "))) (xref--find-definitions identifier nil)) commit 9ea9d21d57f5e698d503f8c4c6c9fbf0e45b3fa0 Author: Eli Zaretskii Date: Sat Aug 21 11:05:04 2021 +0300 ; * lisp/simple.el (execute-extended-command): Fix comment wording. diff --git a/lisp/simple.el b/lisp/simple.el index aa139dd603..db083cfc25 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2240,8 +2240,8 @@ invoking, give a prefix argument to `execute-extended-command'." ;; flight. (when execute-extended-command--binding-timer (cancel-timer execute-extended-command--binding-timer)) - ;; If this command displayed something in the echo area; then - ;; postpone display our suggestion message a bit. + ;; If this command displayed something in the echo area, then + ;; postpone the display of our suggestion message a bit. (when (and suggest-key-bindings (or binding (and extended-command-suggest-shorter typed))) commit 2ed73a722fa2183e18045ef32d4ba13cc574de34 Author: Eli Zaretskii Date: Sat Aug 21 11:01:44 2021 +0300 ; * etc/NEWS: State the default behavior when copying symlinks. diff --git a/etc/NEWS b/etc/NEWS index ec7e54e2dd..02185a6fb4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2468,7 +2468,8 @@ symbolic links, and 'file-precious-flag' is non-nil. +++ *** New user option 'copy-directory-create-symlink'. If non-nil, will make `copy-directory' (when used on a symbolic -link) copy the link instead of following the link. +link) copy the link instead of following the link. The default is +nil, so the default behavior is unchanged. +++ *** New function 'replace-regexp-in-region'. commit beb54dc1b2b00cb4541b82acf6ead8a8075c3011 Author: Eli Zaretskii Date: Sat Aug 21 10:58:24 2021 +0300 Improve documentation of 'file-preserve-symlinks-on-save' * lisp/files.el (file-precious-flag): Mention 'file-preserve-symlinks-on-save' in the doc string. * doc/lispref/files.texi (Saving Buffers): Move the description of 'file-preserve-symlinks-on-save' from here... * doc/emacs/files.texi (Customize Save): ...to here. Improve wording. * etc/NEWS: Fix wording of 'file-preserve-symlinks-on-save' entry. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 207c951a87..9aae0e9a0b 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -742,6 +742,17 @@ always supposed to end in newlines. Such major modes set the variable setting the latter variable, you can control how these modes handle final newlines. +@vindex file-preserve-symlinks-on-save +If this option is non-@code{nil} and you're visiting a file via a +symbolic link, Emacs will break the symbolic link upon saving the +buffer, and will write the buffer to a file with the same name as the +symbolic link, if the value of @code{file-precious-flag} is +non-@code{nil} (@pxref{Saving Buffers, file-precious-flag,, elisp, The +Emacs Lisp Reference Manual}). If you want Emacs to save the buffer +to the file the symbolic link points to (thereby preserving the link) +in these cases, customize the variable +@code{file-preserve-symlinks-on-save} to @code{t}. + @vindex write-region-inhibit-fsync Normally, when a program writes a file, the operating system briefly caches the file's data in main memory before committing the data to diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 12c0611137..266501d46d 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -503,13 +503,6 @@ all hard links between the file you save and other file names. Some modes give this variable a non-@code{nil} buffer-local value in particular buffers. - -@vindex file-preserve-symlinks-on-save -If this option is non-@code{nil} and you're visiting files via a -symbolic link, Emacs break the symbolic link and write the buffer to a -file with the same name as the symbolic link. To instead write to the -file the symbolic link points to (and thereby preserving the link), -set @code{file-preserve-symlinks-on-save} to @code{t}. @end defopt @defopt require-final-newline diff --git a/etc/NEWS b/etc/NEWS index cdc70d6fef..ec7e54e2dd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2462,8 +2462,8 @@ images are marked. +++ *** New user option 'file-preserve-symlinks-on-save'. -This controls what Emacs does when saving buffers visited via a -symbolic link, and 'file-precious-flag' is non-nil. +This controls what Emacs does when saving buffers that visit files via +symbolic links, and 'file-precious-flag' is non-nil. +++ *** New user option 'copy-directory-create-symlink'. diff --git a/lisp/files.el b/lisp/files.el index 6a617feca4..f0baa4fac6 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -257,7 +257,7 @@ This feature is advisory: for example, if the directory in which the file is being saved is not writable, Emacs may ignore a non-nil value of `file-precious-flag' and write directly into the file. -See also: `break-hardlink-on-save'." +See also: `break-hardlink-on-save' and `file-preserve-symlinks-on-save'." :type 'boolean :group 'backup) commit 4b03998458475d98ceabc5b4d0a6279913e77e3a Author: Eli Zaretskii Date: Sat Aug 21 10:37:23 2021 +0300 ; * doc/emacs/custom.texi (Minibuffer Maps): Fix wording. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 9b90656049..cdbb614b77 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1723,7 +1723,7 @@ They do not bind @key{SPC}. By default, @key{TAB}, @key{SPC} and @key{?} do completion in @code{minibuffer-local-completion-map}. If you commonly complete over -collections that have elements that have space or question marks in +collections that have elements with space or question mark characters in them, it may be convenient to disable completion on those keys by putting this in your init file: commit d780b1c5c25c7b6dbdcd08addb69702f0cbcde12 Author: Eli Zaretskii Date: Sat Aug 21 10:31:35 2021 +0300 Fix documentation of 'repeat-mode' changes * doc/emacs/basic.texi (Repeating): Fix indexing. Improve wording. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 6bf180938c..c4fa0d64ed 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -887,6 +887,8 @@ z z z}. The first @kbd{C-x z} repeats the command once, and each subsequent @kbd{z} repeats it once again. @findex repeat-mode +@vindex repeat-exit-key +@vindex repeat-exit-timeout Also you can activate @code{repeat-mode} that temporarily enables a transient mode with short keys after a limited number of commands. Currently supported shorter key sequences are @kbd{C-x u u} instead of @@ -897,6 +899,7 @@ navigate @code{next-error} matches, and @kbd{C-x ] ] [ [} to navigate through pages. Any other key exits transient mode and then is executed normally. The user option @code{repeat-exit-key} defines an additional key to exit this transient mode. Also it's possible to -break the repetition chain automatically after idle time by -customizing the user option @code{repeat-exit-timeout} to a number of -seconds. +break the repetition chain automatically after some idle time by +customizing the user option @code{repeat-exit-timeout} to specify the +idle time in seconds after which this transient mode will be turned +off. commit 9191d127425ea305ca33918efed80cbcdcf101fa Author: Eli Zaretskii Date: Sat Aug 21 10:22:45 2021 +0300 Fix documentation of recently-added tests for files.el * test/lisp/files-tests.el (files-tests--save-some-buffers) (files-tests-save-some-buffers) (files-tests--with-buffer-offer-save) (files-tests-buffer-offer-save): Doc fixes. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index d50a1f19c2..174ec5b074 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1563,12 +1563,12 @@ The door of all subtleties! (defun files-tests--save-some-buffers (pred def-pred-bind exp-1 exp-2) "Helper function to test `save-some-buffers'. -This function creates two visiting-file buffers, BUF-1, BUF-2 in - different directories at the same level, i.e., none of them is a - subdir of the other; then, it modifies both buffers; finally, it calls - `save-some-buffers' from BUF-1 with first arg t, second arg PRED - and `save-some-buffers-default-predicate' let-bound to - DEF-PRED-BIND. +This function creates two file-visiting buffers, BUF-1, BUF-2 in +different directories at the same level, i.e., none of them is a +subdir of the other; then it modifies both buffers; finally, it +calls `save-some-buffers' from BUF-1 with first arg t, second +arg PRED and `save-some-buffers-default-predicate' let-bound to +DEF-PRED-BIND. EXP-1 and EXP-2 are the expected values of calling `buffer-modified-p' on BUF-1 and BUF-2 after the `save-some-buffers' call. @@ -1613,7 +1613,7 @@ let-bound to PRED and passing nil as second arg of (ert-deftest files-tests-save-some-buffers () "Test `save-some-buffers'. -Test the 3 cases for the second argument PRED, i.e., nil, t or +Test the 3 cases for the second argument PRED, i.e., nil, t, or predicate. The value of `save-some-buffers-default-predicate' is ignored unless PRED is nil." @@ -1639,12 +1639,11 @@ PRED is nil." (defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results) "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'. -This macro creates several non-visiting-file buffers in different - directories at the same level, i.e., none of them is a subdir of the - other; then, it modifies the buffers and sets their `buffer-offer-save' - as specified by BUFFERS-OFFER, a list of elements - (BUFFER OFFER-SAVE). Finally, it calls FN-TEST from the first - buffer. +This macro creates several non-file-visiting buffers in different +directories at the same level, i.e., none of them is a subdir of the +other. Then it modifies the buffers and sets their `buffer-offer-save' +as specified by BUFFERS-OFFER, a list of elements (BUFFER OFFER-SAVE). +Finally, it calls FN-TEST from the first buffer. FN-TEST is the function to test: either `save-some-buffers' or `save-buffers-kill-emacs'. This function is called with @@ -1656,9 +1655,9 @@ is a function symbol that this macro temporary binds to BINDING during the FN-TEST call. ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where - FN-ARGS are the arguments for FN-TEST; - CALLERS-DIR specifies the value to let-bind -`save-some-buffers-default-predicate'; +FN-ARGS are the arguments for FN-TEST; +CALLERS-DIR specifies the value to let-bind +\`save-some-buffers-default-predicate'; EXPECTED is the expected result of the test." (declare (debug (form symbol form form))) (let ((dir (gensym "dir")) @@ -1720,8 +1719,8 @@ permutation." (permute ,vec 0 (1- (length ,vec))))))) (ert-deftest files-tests-buffer-offer-save () - "Test `save-some-buffers' for non-visiting buffers. -Check the behavior of `save-some-buffers' for non-visiting-file + "Test `save-some-buffers' for non-file-visiting buffers. +Check the behavior of `save-some-buffers' for non-file-visiting buffers under several values of `buffer-offer-save'. The value of `save-some-buffers-default-predicate' is ignored unless PRED is nil." commit 742ae84a9c53fd8479b0000e907028254a8add7f Author: Eli Zaretskii Date: Sat Aug 21 10:10:28 2021 +0300 ; * lisp/progmodes/project.el: Fix punctuation in the commentary. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index f9b302bb2b..ae9bf03571 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -53,7 +53,7 @@ ;; ;; `project-buffers' can be overridden if the project has some unusual ;; shape (e.g. it contains files residing outside of its root, or some -;; files inside the root must not be considered a part of it). It +;; files inside the root must not be considered a part of it). It ;; should be consistent with `project-files'. ;; ;; This list can change in future versions. commit 77d0ab967d1a2a0cb3f2164583fd4f1a99331c58 Author: Eli Zaretskii Date: Sat Aug 21 09:33:34 2021 +0300 * etc/TODO: Entry about markers being non-scalable. (Bug#49127) diff --git a/etc/TODO b/etc/TODO index 1d6824c470..e199e6b02d 100644 --- a/etc/TODO +++ b/etc/TODO @@ -1538,6 +1538,14 @@ cannot represent in Unicode. *** Performance +**** Make the implementation of markers more eifficient +Markers are implemented as a non-sorted singly linked list of markers. +This makes them scale badly when thousands of markers are created in a +buffer for some purpose, because some low-level primitives in Emacs +traverse the markers' list (e.g., when converting between character +and byte positions), and also because searching for a marker (e.g., +with 'buffer-has-markers-at') becomes very slow. + **** Explore whether overlay-recenter can cure overlays performance problems **** Cache schemas. Need to have list of files and mtimes commit 28170b7d48ec81eb3811551cc1d63401f37cd108 Author: Dmitry Gutov Date: Sat Aug 21 05:26:12 2021 +0300 Speed up project--read-project-buffer in remote buffers * lisp/progmodes/project.el (project-buffers): New generic function. (project--read-project-buffer): Use it here (bug#49264). (project--buffers-to-kill): And here. (project-buffers): Specialized implementation for vc-project. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4620ea8f47..f9b302bb2b 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -51,6 +51,11 @@ ;; files and its relations to external directories. `project-files' ;; should be consistent with `project-ignores'. ;; +;; `project-buffers' can be overridden if the project has some unusual +;; shape (e.g. it contains files residing outside of its root, or some +;; files inside the root must not be considered a part of it). It +;; should be consistent with `project-files'. +;; ;; This list can change in future versions. ;; ;; VC project: @@ -334,6 +339,16 @@ Also quote LOCAL-FILES if `default-directory' is quoted." (concat remote-id file)) local-files)))) +(cl-defgeneric project-buffers (project) + "Return the list of all live buffers that belong to PROJECT." + (let ((root (expand-file-name (file-name-as-directory (project-root project)))) + bufs) + (dolist (buf (buffer-list)) + (when (string-prefix-p root (expand-file-name + (buffer-local-value 'default-directory buf))) + (push buf bufs))) + (nreverse bufs))) + (defgroup project-vc nil "Project implementation based on the VC package." :version "25.1" @@ -628,6 +643,23 @@ DIRS must contain directory names." (hack-dir-local-variables-non-file-buffer)) (symbol-value var))) +(cl-defmethod project-buffers ((project (head vc))) + (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) + (modules (unless (or (project--vc-merge-submodules-p root) + (project--submodule-p root)) + (mapcar + (lambda (m) (format "%s%s/" root m)) + (project--git-submodules)))) + dd + bufs) + (dolist (buf (buffer-list)) + (setq dd (expand-file-name (buffer-local-value 'default-directory buf))) + (when (and (string-prefix-p root dd) + (not (cl-find-if (lambda (module) (string-prefix-p module dd)) + modules))) + (push buf bufs))) + (nreverse bufs))) + ;;; Project commands @@ -1014,13 +1046,11 @@ If non-nil, it overrides `compilation-buffer-name-function' for (current-buffer (current-buffer)) (other-buffer (other-buffer current-buffer)) (other-name (buffer-name other-buffer)) + (buffers (project-buffers pr)) (predicate (lambda (buffer) ;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist. - (and (cdr buffer) - (equal pr - (with-current-buffer (cdr buffer) - (project-current))))))) + (memq (cdr buffer) buffers)))) (read-buffer "Switch to buffer: " (when (funcall predicate (cons other-name other-buffer)) @@ -1160,7 +1190,7 @@ of CONDITIONS." What buffers should or should not be killed is described in `project-kill-buffer-conditions'." (let (bufs) - (dolist (buf (project--buffer-list pr)) + (dolist (buf (project-buffers pr)) (when (project--kill-buffer-check buf project-kill-buffer-conditions) (push buf bufs))) bufs)) commit 222d033254e1c0c918f3dec523517f3192bc7086 Author: Glenn Morris Date: Fri Aug 20 15:56:27 2021 -0700 * lisp/bindings.el (page-navigation-repeat-map): Fix bootstrap. diff --git a/lisp/bindings.el b/lisp/bindings.el index b67c6ad638..b8bf0c1a6f 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1437,8 +1437,8 @@ if `inhibit-field-text-motion' is non-nil." (defvar page-navigation-repeat-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "]") #'forward-page) - (define-key map (kbd "[") #'backward-page) + (define-key map "]" #'forward-page) + (define-key map "[" #'backward-page) map) "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.") commit 13824c44d28427931a7e3284adec9a3a38cd2323 Author: Alan Mackenzie Date: Fri Aug 20 21:12:37 2021 +0000 Fix c-tentative-buffer-changes to be nestable in c-save-buffer-state * lisp/progmodes/cc-defs.el (c-tentative-buffer-changes) (c-tnt-chng-record-state, c-tnt-chng-cleanup): Enhance such that a buffer-undo-list of t is handled specially, so that a nil isn't consed onto it. Thus garbage collection can't later remove the (nil . t) from the end of the buffer-undo-list, causing an infinite loop. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 01bd64cb5c..3cb1912b73 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -660,19 +660,27 @@ even when the buffer is read-only, and without interference from various buffer change hooks." (declare (indent 0) (debug t)) `(let (-tnt-chng-keep - -tnt-chng-state) + -tnt-chng-state + (old-undo-list buffer-undo-list)) (unwind-protect ;; Insert an undo boundary for use with `undo-more'. We ;; don't use `undo-boundary' since it doesn't insert one ;; unconditionally. - (setq buffer-undo-list (cons nil buffer-undo-list) - -tnt-chng-state (c-tnt-chng-record-state) + (setq buffer-undo-list + (if (eq old-undo-list t) + nil + (cons nil buffer-undo-list)) + old-undo-list (if (eq old-undo-list t) + t + buffer-undo-list) + -tnt-chng-state (c-tnt-chng-record-state + old-undo-list) -tnt-chng-keep (progn ,@body)) (c-tnt-chng-cleanup -tnt-chng-keep -tnt-chng-state)))) -(defun c-tnt-chng-record-state () +(defun c-tnt-chng-record-state (old-undo-list) ;; Used internally in `c-tentative-buffer-changes'. - (vector buffer-undo-list ; 0 + (vector old-undo-list ; 0 (current-buffer) ; 1 ;; No need to use markers for the point and mark; if the ;; undo got out of synch we're hosed anyway. @@ -690,18 +698,26 @@ various buffer change hooks." (setq buffer-undo-list (cdr saved-undo-list)) (if keep - ;; Find and remove the undo boundary. - (let ((p buffer-undo-list)) - (while (not (eq (cdr p) saved-undo-list)) - (setq p (cdr p))) - (setcdr p (cdr saved-undo-list))) - - ;; `primitive-undo' will remove the boundary. - (setq saved-undo-list (cdr saved-undo-list)) - (let ((undo-in-progress t)) - (while (not (eq (setq buffer-undo-list - (primitive-undo 1 buffer-undo-list)) - saved-undo-list)))) + (if (eq saved-undo-list t) + (progn + (c-benign-error + "Can't save additional undo list in c-tnt-chng-cleanup") + (setq buffer-undo-list t)) + ;; Find and remove the undo boundary. + (let ((p buffer-undo-list)) + (while (not (eq (cdr p) saved-undo-list)) + (setq p (cdr p))) + (setcdr p (cdr saved-undo-list)))) + + (let ((undo-in-progress t) + (end-undo-list (if (eq saved-undo-list t) + nil + ;; `primitive-undo' will remove the boundary. + (cdr saved-undo-list)))) + (while (not (eq buffer-undo-list end-undo-list)) + (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))) + (if (eq saved-undo-list t) + (setq buffer-undo-list t)) (when (buffer-live-p (elt saved-state 1)) (set-buffer (elt saved-state 1)) commit 681faf9f0bc41972932b72ef34c026419b6eb54d Author: Tino Calancha Date: Fri Aug 20 18:07:19 2021 +0200 ; * test/lisp/files-tests.el: Add tests for save-some-buffers (Bug#46374) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index fb24b98595..d50a1f19c2 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1560,5 +1560,219 @@ The door of all subtleties! (find-file (ert-resource-file "auto-test.zot3")) (should (eq major-mode 'fundamental-mode))) +(defun files-tests--save-some-buffers (pred def-pred-bind exp-1 exp-2) + "Helper function to test `save-some-buffers'. + +This function creates two visiting-file buffers, BUF-1, BUF-2 in + different directories at the same level, i.e., none of them is a + subdir of the other; then, it modifies both buffers; finally, it calls + `save-some-buffers' from BUF-1 with first arg t, second arg PRED + and `save-some-buffers-default-predicate' let-bound to + DEF-PRED-BIND. + +EXP-1 and EXP-2 are the expected values of calling `buffer-modified-p' +on BUF-1 and BUF-2 after the `save-some-buffers' call. + +The test is repeated with `save-some-buffers-default-predicate' +let-bound to PRED and passing nil as second arg of +`save-some-buffers'." + (let* ((dir (make-temp-file "testdir" 'dir)) + (file-1 (expand-file-name "subdir-1/file.foo" dir)) + (file-2 (expand-file-name "subdir-2/file.bar" dir)) + (inhibit-message t) + buf-1 buf-2) + (unwind-protect + (progn + (make-empty-file file-1 'parens) + (make-empty-file file-2 'parens) + (setq buf-1 (find-file file-1) + buf-2 (find-file file-2)) + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf (insert "foobar\n"))) + ;; Run the test. + (with-current-buffer buf-1 + (let ((save-some-buffers-default-predicate def-pred-bind)) + (save-some-buffers t pred)) + (should (eq exp-1 (buffer-modified-p buf-1))) + (should (eq exp-2 (buffer-modified-p buf-2)))) + ;; Set both buffers as modified to run another test. + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf (set-buffer-modified-p t))) + ;; The result of this test must be identical as the previous one. + (with-current-buffer buf-1 + (let ((save-some-buffers-default-predicate (or pred def-pred-bind))) + (save-some-buffers t nil)) + (should (eq exp-1 (buffer-modified-p buf-1))) + (should (eq exp-2 (buffer-modified-p buf-2))))) + ;; Clean up. + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))) + (delete-directory dir 'recursive)))) + +(ert-deftest files-tests-save-some-buffers () + "Test `save-some-buffers'. +Test the 3 cases for the second argument PRED, i.e., nil, t or +predicate. +The value of `save-some-buffers-default-predicate' is ignored unless +PRED is nil." + (let* ((foo-file-p (lambda () (string-suffix-p ".foo" buffer-file-name))) + (bar-file-p (lambda () (string-suffix-p ".bar" buffer-file-name))) + (args-results `((nil nil nil nil) + (nil ,foo-file-p nil t) + (nil ,bar-file-p t nil) + (,foo-file-p nil nil t) + (,bar-file-p nil t nil) + + (buffer-modified-p nil nil nil) + (t nil nil nil) + (t ,foo-file-p nil nil) + + (,foo-file-p save-some-buffers-root nil t) + (nil save-some-buffers-root nil t) + (,bar-file-p save-some-buffers-root t nil) + (t save-some-buffers-root nil nil)))) + (pcase-dolist (`(,pred ,def-pred-bind ,exp-1 ,exp-2) args-results) + (files-tests--save-some-buffers pred def-pred-bind exp-1 exp-2)))) + +(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results) + "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'. + +This macro creates several non-visiting-file buffers in different + directories at the same level, i.e., none of them is a subdir of the + other; then, it modifies the buffers and sets their `buffer-offer-save' + as specified by BUFFERS-OFFER, a list of elements + (BUFFER OFFER-SAVE). Finally, it calls FN-TEST from the first + buffer. + +FN-TEST is the function to test: either `save-some-buffers' or +`save-buffers-kill-emacs'. This function is called with +`save-some-buffers-default-predicate' let-bound to a value +specified inside ARGS-RESULTS. + +FN-BINDERS is a list of elements (FUNCTION . BINDING), where FUNCTION +is a function symbol that this macro temporary binds to BINDING during +the FN-TEST call. + +ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where + FN-ARGS are the arguments for FN-TEST; + CALLERS-DIR specifies the value to let-bind +`save-some-buffers-default-predicate'; + EXPECTED is the expected result of the test." + (declare (debug (form symbol form form))) + (let ((dir (gensym "dir")) + (buffers (gensym "buffers"))) + `(let* ((,dir (make-temp-file "testdir" 'dir)) + (inhibit-message t) + (use-dialog-box nil) + ,buffers) + (pcase-dolist (`(,bufsym ,offer-save) ,buffers-offer) + (let* ((buf (generate-new-buffer (symbol-name bufsym))) + (subdir (expand-file-name + (format "subdir-%s" (buffer-name buf)) + ,dir))) + (make-directory subdir 'parens) + (push buf ,buffers) + (with-current-buffer buf + (cd subdir) + (setq buffer-offer-save offer-save) + (insert "foobar\n")))) + (setq ,buffers (nreverse ,buffers)) + (let ((nb-saved-buffers 0)) + (unwind-protect + (pcase-dolist (`(,fn-test-args ,callers-dir ,expected) + ,args-results) + (setq nb-saved-buffers 0) + (with-current-buffer (car ,buffers) + (cl-letf + (,@(mapcar (lambda (pair) `((symbol-function ,(car pair)) ,(cdr pair))) + fn-binders) + (save-some-buffers-default-predicate callers-dir)) + (apply #',fn-test fn-test-args) + (should (equal nb-saved-buffers expected))))) + ;; Clean up. + (dolist (buf ,buffers) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))) + (delete-directory ,dir 'recursive)))))) + +(defmacro files-tests-with-all-permutations (permutation list &rest body) + "Execute BODY forms for all permutations of LIST. +Execute the forms with the symbol PERMUTATION bound to the current +permutation." + (declare (indent 2) (debug (symbol form body))) + (let ((vec (gensym "vec"))) + `(let ((,vec (vconcat ,list))) + (cl-labels ((swap (,vec i j) + (let ((tmp (aref ,vec j))) + (aset ,vec j (aref ,vec i)) + (aset ,vec i tmp))) + (permute (,vec l r) + (if (= l r) + (let ((,permutation (append ,vec nil))) + ,@body) + (cl-loop for idx from l below (1+ r) do + (swap ,vec idx l) + (permute ,vec (1+ l) r) + (swap ,vec idx l))))) + (permute ,vec 0 (1- (length ,vec))))))) + +(ert-deftest files-tests-buffer-offer-save () + "Test `save-some-buffers' for non-visiting buffers. +Check the behavior of `save-some-buffers' for non-visiting-file +buffers under several values of `buffer-offer-save'. +The value of `save-some-buffers-default-predicate' is ignored unless +PRED is nil." + (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil))) + (nb-might-save + (length + (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init))) + (nb-always-save + (length + (cl-remove-if-not (lambda (l) (eq 'always (cadr l))) buffers-offer-init)))) + (files-tests-with-all-permutations + buffers-offer + buffers-offer-init + (dolist (pred `(nil t save-some-buffers-root)) + (dolist (callers-dir `(nil save-some-buffers-root)) + (let* ((head-offer (cadar buffers-offer)) + (res (cond ((null pred) + (if (null callers-dir) nb-always-save (or (and head-offer 1) 0))) + (t + ;; Save any buffer with `buffer-offer-save' non-nil. + (if (eq pred t) nb-might-save + ;; Restrict to caller's dir. + (or (and head-offer 1) 0))))) + (args-res `(((nil ,pred) ,callers-dir ,res)))) + (files-tests--with-buffer-offer-save + buffers-offer + save-some-buffers + ;; Increase counter and answer 'n' when prompted to save a buffer. + (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n))) + args-res))))))) + +(ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers () + "Test that `save-buffers-kill-emacs' asks to save buffers as expected. +Prompt users for any modified buffer with `buffer-offer-save' non-nil." + (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil))) + (nb-might-save + (length + (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init)))) + (files-tests-with-all-permutations + buffers-offer + buffers-offer-init + (files-tests--with-buffer-offer-save + buffers-offer + save-buffers-kill-emacs + ;; Increase counter and answer 'n' when prompted to save a buffer. + (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n)) + ('kill-emacs . #'ignore)) ; Do not kill Emacs. + `((nil nil ,nb-might-save) + ;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored. + (nil save-some-buffers-root ,nb-might-save)))))) + + (provide 'files-tests) ;;; files-tests.el ends here commit 63cbb54d7e163f74657dba46829262282ccda0df Author: Davide Masserut Date: Fri Aug 20 17:49:35 2021 +0200 Mark page navigation commands as repeatable * doc/emacs/basic.texi (Repeating): Document page navigation repeatability. * lisp/bindings.el (page-navigation-repeat-map): Add new map (bug#50137). * lisp/bindings.el (forward-page): (backward-page): Mark as repeatable. Copyright-paperwork-exempt: yes diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index ba8d822b18..6bf180938c 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -887,15 +887,16 @@ z z z}. The first @kbd{C-x z} repeats the command once, and each subsequent @kbd{z} repeats it once again. @findex repeat-mode - Also you can activate @code{repeat-mode} that temporarily enables -a transient mode with short keys after a limited number of commands. + Also you can activate @code{repeat-mode} that temporarily enables a +transient mode with short keys after a limited number of commands. Currently supported shorter key sequences are @kbd{C-x u u} instead of @kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of @kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^ v v} to resize the selected window interactively, @kbd{M-g n n p p} to -navigate @code{next-error} matches. Any other key exits transient mode -and then is executed normally. The user option @code{repeat-exit-key} -defines an additional key to exit this transient mode. Also it's -possible to break the repetition chain automatically after idle time -by customizing the user option @code{repeat-exit-timeout} to a number -of seconds. +navigate @code{next-error} matches, and @kbd{C-x ] ] [ [} to navigate +through pages. Any other key exits transient mode and then is +executed normally. The user option @code{repeat-exit-key} defines an +additional key to exit this transient mode. Also it's possible to +break the repetition chain automatically after idle time by +customizing the user option @code{repeat-exit-timeout} to a number of +seconds. diff --git a/lisp/bindings.el b/lisp/bindings.el index 0345944894..b67c6ad638 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1434,6 +1434,17 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "[" 'backward-page) (define-key ctl-x-map "]" 'forward-page) + +(defvar page-navigation-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "]") #'forward-page) + (define-key map (kbd "[") #'backward-page) + map) + "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.") + +(put 'forward-page 'repeat-map 'page-navigation-repeat-map) +(put 'backward-page 'repeat-map 'page-navigation-repeat-map) + (define-key ctl-x-map "\C-p" 'mark-page) (define-key ctl-x-map "l" 'count-lines-page) (define-key ctl-x-map "np" 'narrow-to-page) commit b2b9f69b9db7fdedfa90764beced74a7831f50de Author: Lars Ingebrigtsen Date: Fri Aug 20 17:00:10 2021 +0200 Document how to get rid of completion on `SPC' and `?' * doc/emacs/custom.texi (Minibuffer Maps): Mention how to get rid of completion on `SPC' and `?' (bug#16528). diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 999234e6d3..9b90656049 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1721,6 +1721,17 @@ previous ones, but they are specifically for file name completion. They do not bind @key{SPC}. @end itemize +By default, @key{TAB}, @key{SPC} and @key{?} do completion in +@code{minibuffer-local-completion-map}. If you commonly complete over +collections that have elements that have space or question marks in +them, it may be convenient to disable completion on those keys by +putting this in your init file: + +@lisp +(define-key minibuffer-local-completion-map " " 'self-insert-command) +(define-key minibuffer-local-completion-map "?" 'self-insert-command) +@end lisp + @node Rebinding @subsection Changing Key Bindings Interactively @cindex key rebinding, this session commit ac2cecbd83428d04b98cc1ef48ec098978141295 Author: Lars Ingebrigtsen Date: Fri Aug 20 16:35:56 2021 +0200 Fix printing of C-@ in `describe-fontset' * lisp/international/mule-diag.el (mule--kbd-at): New function (bug#17836). (print-fontset-element): Use it to get multi-key things correct. diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 02169ceb68..864cd3ce01 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -862,15 +862,28 @@ The IGNORED argument is ignored." (defvar mule--print-opened) +(defun mule--kbd-at (point) + (save-excursion + (goto-char point) + (elt + (kbd (buffer-substring + (point) + (progn + ;; Might be a space, in which case we want it. + (if (zerop (skip-chars-forward "^ ")) + (1+ (point)) + (point))))) + 0))) + (defun print-fontset-element (val) ;; VAL has this format: ;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...) ;; CHAR RANGE is already inserted. Get character codes from ;; the current line. (beginning-of-line) - (let ((from (following-char)) + (let ((from (mule--kbd-at (point))) (to (if (looking-at "[^.]*[.]* ") - (char-after (match-end 0))))) + (mule--kbd-at (match-end 0))))) (if (re-search-forward "[ \t]*$" nil t) (delete-region (match-beginning 0) (match-end 0))) commit 13fdded2c19823d9216b391d0636345029cf3e81 Author: Lars Ingebrigtsen Date: Fri Aug 20 16:20:51 2021 +0200 Allow preserving symlinks with file-precious-flag set * doc/lispref/files.texi (Saving Buffers): Document it. * lisp/files.el (file-preserve-symlinks-on-save): New user option (bug#18125). (basic-save-buffer-2): Use it. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 266501d46d..12c0611137 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -503,6 +503,13 @@ all hard links between the file you save and other file names. Some modes give this variable a non-@code{nil} buffer-local value in particular buffers. + +@vindex file-preserve-symlinks-on-save +If this option is non-@code{nil} and you're visiting files via a +symbolic link, Emacs break the symbolic link and write the buffer to a +file with the same name as the symbolic link. To instead write to the +file the symbolic link points to (and thereby preserving the link), +set @code{file-preserve-symlinks-on-save} to @code{t}. @end defopt @defopt require-final-newline diff --git a/etc/NEWS b/etc/NEWS index 7cd0c5fc4e..cdc70d6fef 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2460,6 +2460,11 @@ images are marked. ** Miscellaneous ++++ +*** New user option 'file-preserve-symlinks-on-save'. +This controls what Emacs does when saving buffers visited via a +symbolic link, and 'file-precious-flag' is non-nil. + +++ *** New user option 'copy-directory-create-symlink'. If non-nil, will make `copy-directory' (when used on a symbolic diff --git a/lisp/files.el b/lisp/files.el index 90de149934..6a617feca4 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5446,6 +5446,14 @@ symbolic link and copy the contents instead." :version "28.1" :group 'files) +(defcustom file-preserve-symlinks-on-save nil + "If non-nil, saving a buffer visited via a symlink won't overwrite the symlink. +This is only relevant if `file-precious-flag' is non-nil -- if +this is nil, Emacs will preserve the symlinks anyway." + :type 'boolean + :version "28.1" + :group 'files) + (defvar-local save-buffer-coding-system nil "If non-nil, use this coding system for saving the buffer. More precisely, use this coding system in place of the @@ -5648,7 +5656,14 @@ Before and after saving the buffer, this function runs buffer-file-name))) ;; We succeeded in writing the temp file, ;; so rename it. - (rename-file tempname buffer-file-name t)) + (rename-file tempname + (if (and file-preserve-symlinks-on-save + (file-symlink-p buffer-file-name)) + ;; Write to the file that the symlink + ;; points to. + (file-chase-links buffer-file-name) + buffer-file-name) + t)) ;; If file not writable, see if we can make it writable ;; temporarily while we write it. ;; But no need to do so if we have just backed it up commit e1a209ef41ab0f0d11c93c863524ad3c9d4acdc5 Author: Lars Ingebrigtsen Date: Fri Aug 20 15:57:06 2021 +0200 Fix infinite recursion in mode: tex * lisp/textmodes/tex-mode.el (tex--redirect-to-submode): Inhibit recursion when called from file-local variables (bug#50126). diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index c53acf53e7..2a61e4e9a3 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1016,10 +1016,14 @@ says which mode to use." (advice-add 'tex-mode :around #'tex--redirect-to-submode) (defun tex--redirect-to-submode (orig-fun) "Redirect to one of the submodes when called directly." - (funcall (if delay-mode-hooks - ;; We're called from one of the children already. - orig-fun - (tex--guess-mode)))) + ;; The file may have "mode: tex" in the local variable + ;; block, in which case we'll be called recursively + ;; infinitely. Inhibit that. + (let ((enable-local-variables nil)) + (funcall (if delay-mode-hooks + ;; We're called from one of the children already. + orig-fun + (tex--guess-mode))))) ;; The following three autoloaded aliases appear to conflict with ;; AUCTeX. However, even though AUCTeX uses the mixed case variants commit c2026cf3667c0b68a99deed2896b97ce2cf7f5cb Author: Lars Ingebrigtsen Date: Fri Aug 20 15:55:24 2021 +0200 Fix infinite recursion of conf-mode * lisp/textmodes/conf-mode.el (conf-mode): Inhibit recursion when called from file-local variables (bug#50126). diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 5f34ae152d..949d8cbdab 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -420,7 +420,11 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode', (advice-add 'conf-mode :around (lambda (orig-fun) "Redirect to one of the submodes when called directly." - (funcall (if delay-mode-hooks orig-fun (conf--guess-mode))))) + ;; The file may have "mode: conf" in the local variable + ;; block, in which case we'll be called recursively + ;; infinitely. Inhibit that. + (let ((enable-local-variables nil)) + (funcall (if delay-mode-hooks orig-fun (conf--guess-mode)))))) commit 657fe8b9d87dd17d9b50dd8e15bfd917c6c630b2 Author: Marco Centurion Date: Fri Aug 20 15:43:41 2021 +0200 Allow copy-directory to copy the source as a symlink * doc/emacs/files.texi (Copying and Naming): Document it. * lisp/files.el (copy-directory): Allow copying symbolic links as is (bug#10897). (copy-directory-create-symlink): New user option. Copyright-paperwork-exempt: yes diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 8304e40706..207c951a87 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1728,12 +1728,16 @@ exists. @kbd{M-x copy-file} copies the contents of the file @var{old} to the file @var{new}. +@vindex copy-directory-create-symlink @findex copy-directory @kbd{M-x copy-directory} copies directories, similar to the @command{cp -r} shell command. If @var{new} is a directory name, it creates a copy of the @var{old} directory and puts it in @var{new}. Otherwise it copies all the contents of @var{old} into a new directory -named @var{new}. +named @var{new}. If @code{copy-directory-create-symlink} is +non-@code{nil} and @var{old} is a symbolic link, this command will +copy the symbolic link. If @code{nil}, this command will follow the +link and copy the contents instead. (This is the default.) @cindex renaming files @findex rename-file diff --git a/etc/NEWS b/etc/NEWS index b221f13624..7cd0c5fc4e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2460,6 +2460,11 @@ images are marked. ** Miscellaneous ++++ +*** New user option 'copy-directory-create-symlink'. +If non-nil, will make `copy-directory' (when used on a symbolic +link) copy the link instead of following the link. + +++ *** New function 'replace-regexp-in-region'. diff --git a/lisp/files.el b/lisp/files.el index 77977f1411..90de149934 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5437,6 +5437,15 @@ Used only by `save-buffer'." :type 'hook :group 'files) +(defcustom copy-directory-create-symlink nil + "This option influences the handling of symbolic links in `copy-directory'. +If non-nil, `copy-directory' will create a symbolic link if the +source directory is a symbolic link. If nil, it'll follow the +symbolic link and copy the contents instead." + :type 'boolean + :version "28.1" + :group 'files) + (defvar-local save-buffer-coding-system nil "If non-nil, use this coding system for saving the buffer. More precisely, use this coding system in place of the @@ -6165,6 +6174,9 @@ Noninteractively, the PARENTS argument says whether to create parent directories if they don't exist. Interactively, this happens by default. +If DIRECTORY is a symlink and `copy-directory-create-symlink' is +non-nil, create a symlink with the same target as DIRECTORY. + If NEWNAME is a directory name, copy DIRECTORY as a subdirectory there. However, if called from Lisp with a non-nil optional argument COPY-CONTENTS, copy the contents of DIRECTORY directly @@ -6193,42 +6205,53 @@ into NEWNAME instead." (setq directory (directory-file-name (expand-file-name directory)) newname (expand-file-name newname)) - (cond ((not (directory-name-p newname)) - ;; If NEWNAME is not a directory name, create it; - ;; that is where we will copy the files of DIRECTORY. - (make-directory newname parents)) - ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil, - ;; create NEWNAME if it is not already a directory; - ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME]. - ((if copy-contents - (or parents (not (file-directory-p newname))) - (setq newname (concat newname - (file-name-nondirectory directory)))) - (make-directory (directory-file-name newname) parents)) - (t (setq follow t))) - - ;; Copy recursively. - (dolist (file - ;; We do not want to copy "." and "..". - (directory-files directory 'full - directory-files-no-dot-files-regexp)) - (let ((target (concat (file-name-as-directory newname) - (file-name-nondirectory file))) - (filetype (car (file-attributes file)))) - (cond - ((eq filetype t) ; Directory but not a symlink. - (copy-directory file target keep-time parents t)) - ((stringp filetype) ; Symbolic link - (make-symbolic-link filetype target t)) - ((copy-file file target t keep-time))))) - - ;; Set directory attributes. - (let ((modes (file-modes directory)) - (times (and keep-time (file-attribute-modification-time - (file-attributes directory)))) - (follow-flag (unless follow 'nofollow))) - (if modes (set-file-modes newname modes follow-flag)) - (if times (set-file-times newname times follow-flag)))))) + ;; If DIRECTORY is a symlink, create a symlink with the same target. + (if (and (file-symlink-p directory) + copy-directory-create-symlink) + (let ((target (car (file-attributes directory)))) + (if (directory-name-p newname) + (make-symbolic-link target + (concat newname + (file-name-nondirectory directory)) + t) + (make-symbolic-link target newname t))) + ;; Else proceed to copy as a regular directory + (cond ((not (directory-name-p newname)) + ;; If NEWNAME is not a directory name, create it; + ;; that is where we will copy the files of DIRECTORY. + (make-directory newname parents)) + ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil, + ;; create NEWNAME if it is not already a directory; + ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME]. + ((if copy-contents + (or parents (not (file-directory-p newname))) + (setq newname (concat newname + (file-name-nondirectory directory)))) + (make-directory (directory-file-name newname) parents)) + (t (setq follow t))) + + ;; Copy recursively. + (dolist (file + ;; We do not want to copy "." and "..". + (directory-files directory 'full + directory-files-no-dot-files-regexp)) + (let ((target (concat (file-name-as-directory newname) + (file-name-nondirectory file))) + (filetype (car (file-attributes file)))) + (cond + ((eq filetype t) ; Directory but not a symlink. + (copy-directory file target keep-time parents t)) + ((stringp filetype) ; Symbolic link + (make-symbolic-link filetype target t)) + ((copy-file file target t keep-time))))) + + ;; Set directory attributes. + (let ((modes (file-modes directory)) + (times (and keep-time (file-attribute-modification-time + (file-attributes directory)))) + (follow-flag (unless follow 'nofollow))) + (if modes (set-file-modes newname modes follow-flag)) + (if times (set-file-times newname times follow-flag))))))) ;; At time of writing, only info uses this. commit 00a9c50ad7c82f72b422100624f7f125d717c00f Author: Lars Ingebrigtsen Date: Fri Aug 20 15:07:24 2021 +0200 Further tweaks to execute-extended-command * lisp/simple.el (execute-extended-command): Move finding the short command to the timer command, too (bug#50042). This further ensures that post-command-hook is run faster. diff --git a/lisp/simple.el b/lisp/simple.el index 24e77eeb3f..aa139dd603 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2220,7 +2220,8 @@ invoking, give a prefix argument to `execute-extended-command'." (binding (and suggest-key-bindings (not executing-kbd-macro) (where-is-internal function overriding-local-map t))) - (delay-before-suggest 0)) + (delay-before-suggest 0) + (find-shorter nil)) (unless (commandp function) (error "`%s' is not a valid command name" command-name)) ;; Some features, such as novice.el, rely on this-command-keys @@ -2235,12 +2236,12 @@ invoking, give a prefix argument to `execute-extended-command'." (setq real-this-command function) (let ((prefix-arg prefixarg)) (command-execute function 'record)) - ;; If enabled, show which key runs this command. - - ;; If this command displayed something in the echo area; - ;; then postpone display our suggestion message a bit. - ;; FIXME: If execute-extended-command--shorter were - ;; faster, we could compute the result here first too. + ;; Ensure that we never have two of the suggest-binding timers in + ;; flight. + (when execute-extended-command--binding-timer + (cancel-timer execute-extended-command--binding-timer)) + ;; If this command displayed something in the echo area; then + ;; postpone display our suggestion message a bit. (when (and suggest-key-bindings (or binding (and extended-command-suggest-shorter typed))) @@ -2248,36 +2249,39 @@ invoking, give a prefix argument to `execute-extended-command'." (cond ((zerop (length (current-message))) 0) ((numberp suggest-key-bindings) suggest-key-bindings) - (t 2)))) - (unless (or (not extended-command-suggest-shorter) - binding executing-kbd-macro (not (symbolp function)) - (<= (length (symbol-name function)) 2)) - ;; There's no binding for CMD. Let's try and find the shortest - ;; string to use in M-x. - ;; FIXME: Can be slow. Cache it maybe? - (while-no-input - (setq binding (execute-extended-command--shorter - (symbol-name function) typed)))) - ;; Ensure that we never have two of these timers in flight. - (when execute-extended-command--binding-timer - (cancel-timer execute-extended-command--binding-timer)) - (when binding - (setq execute-extended-command--binding-timer - (run-at-time - delay-before-suggest nil - (lambda () - ;; If the user has typed any other commands in the - ;; meantime, then don't display anything. - (when (eq function real-last-command) - (with-temp-message - (format-message "You can run the command `%s' with %s" - function - (if (stringp binding) - (concat "M-x " binding " RET") - (key-description binding))) - (sit-for (if (numberp suggest-key-bindings) - suggest-key-bindings - 2)))))))))) + (t 2))) + (when (and extended-command-suggest-shorter + (not binding) + (not executing-kbd-macro) + (symbolp function) + (> (length (symbol-name function)) 2)) + ;; There's no binding for CMD. Let's try and find the shortest + ;; string to use in M-x. + (setq find-shorter t)) + (when (or binding find-shorter) + (setq execute-extended-command--binding-timer + (run-at-time + delay-before-suggest nil + (lambda () + ;; If the user has typed any other commands in the + ;; meantime, then don't display anything. + (when (eq function real-last-command) + ;; Find shorter string. + (when find-shorter + (while-no-input + ;; FIXME: Can be slow. Cache it maybe? + (setq binding (execute-extended-command--shorter + (symbol-name function) typed)))) + (when binding + (with-temp-message + (format-message "You can run the command `%s' with %s" + function + (if (stringp binding) + (concat "M-x " binding " RET") + (key-description binding))) + (sit-for (if (numberp suggest-key-bindings) + suggest-key-bindings + 2)))))))))))) (defun execute-extended-command-for-buffer (prefixarg &optional command-name typed) commit 969c3135d6998903d640353cb039da4945c71f79 Author: Lars Ingebrigtsen Date: Fri Aug 20 14:55:40 2021 +0200 Remove even more waiting from execute-extended-command * lisp/simple.el (execute-extended-command): Remove all the waiting from the command and do it all with timers (bug#50042). This ensures that post-command-hook is run immediately also when the command has messaged something. diff --git a/lisp/simple.el b/lisp/simple.el index 7da315e869..24e77eeb3f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2219,7 +2219,8 @@ invoking, give a prefix argument to `execute-extended-command'." (let* ((function (and (stringp command-name) (intern-soft command-name))) (binding (and suggest-key-bindings (not executing-kbd-macro) - (where-is-internal function overriding-local-map t)))) + (where-is-internal function overriding-local-map t))) + (delay-before-suggest 0)) (unless (commandp function) (error "`%s' is not a valid command name" command-name)) ;; Some features, such as novice.el, rely on this-command-keys @@ -2235,49 +2236,48 @@ invoking, give a prefix argument to `execute-extended-command'." (let ((prefix-arg prefixarg)) (command-execute function 'record)) ;; If enabled, show which key runs this command. - ;; But first wait, and skip the message if there is input. - (let* ((waited - ;; If this command displayed something in the echo area; - ;; wait a few seconds, then display our suggestion message. - ;; FIXME: Wait *after* running post-command-hook! - ;; FIXME: If execute-extended-command--shorter were - ;; faster, we could compute the result here first too. - (when (and suggest-key-bindings - (or binding - (and extended-command-suggest-shorter typed))) - (sit-for (cond - ((zerop (length (current-message))) 0) - ((numberp suggest-key-bindings) suggest-key-bindings) - (t 2)))))) - (when (and waited (not (consp unread-command-events))) - (unless (or (not extended-command-suggest-shorter) - binding executing-kbd-macro (not (symbolp function)) - (<= (length (symbol-name function)) 2)) - ;; There's no binding for CMD. Let's try and find the shortest - ;; string to use in M-x. - ;; FIXME: Can be slow. Cache it maybe? - (while-no-input - (setq binding (execute-extended-command--shorter - (symbol-name function) typed)))) - (when binding - ;; This is normally not necessary -- the timer should run - ;; immediately, but be defensive and ensure that we never - ;; have two of these timers in flight. - (when execute-extended-command--binding-timer - (cancel-timer execute-extended-command--binding-timer)) - (setq execute-extended-command--binding-timer - (run-at-time - 0 nil - (lambda () - (with-temp-message - (format-message "You can run the command `%s' with %s" - function - (if (stringp binding) - (concat "M-x " binding " RET") - (key-description binding))) - (sit-for (if (numberp suggest-key-bindings) - suggest-key-bindings - 2))))))))))) + + ;; If this command displayed something in the echo area; + ;; then postpone display our suggestion message a bit. + ;; FIXME: If execute-extended-command--shorter were + ;; faster, we could compute the result here first too. + (when (and suggest-key-bindings + (or binding + (and extended-command-suggest-shorter typed))) + (setq delay-before-suggest + (cond + ((zerop (length (current-message))) 0) + ((numberp suggest-key-bindings) suggest-key-bindings) + (t 2)))) + (unless (or (not extended-command-suggest-shorter) + binding executing-kbd-macro (not (symbolp function)) + (<= (length (symbol-name function)) 2)) + ;; There's no binding for CMD. Let's try and find the shortest + ;; string to use in M-x. + ;; FIXME: Can be slow. Cache it maybe? + (while-no-input + (setq binding (execute-extended-command--shorter + (symbol-name function) typed)))) + ;; Ensure that we never have two of these timers in flight. + (when execute-extended-command--binding-timer + (cancel-timer execute-extended-command--binding-timer)) + (when binding + (setq execute-extended-command--binding-timer + (run-at-time + delay-before-suggest nil + (lambda () + ;; If the user has typed any other commands in the + ;; meantime, then don't display anything. + (when (eq function real-last-command) + (with-temp-message + (format-message "You can run the command `%s' with %s" + function + (if (stringp binding) + (concat "M-x " binding " RET") + (key-description binding))) + (sit-for (if (numberp suggest-key-bindings) + suggest-key-bindings + 2)))))))))) (defun execute-extended-command-for-buffer (prefixarg &optional command-name typed) commit 573e8eef86acb560541226465817d5a84efeebc5 Author: Mattias Engdegård Date: Fri Aug 20 13:51:36 2021 +0200 ; * lisp/mouse.el: Fix typos in previous change diff --git a/lisp/mouse.el b/lisp/mouse.el index 4dcc2f28f4..3441a4787e 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -455,9 +455,9 @@ CLICK-SYM and DOWN-SYM are the mouse click and down key symbols to use." context-menu--saved-bindings) (global-set-key down context-menu-entry))) -(defun context-menu--reset-bindings () +(defun context-menu--restore-bindings () "Restore saved `context-menu-mode' bindings." - (pcase-dolist (`(sym . binding) context-menu--saved-bindings) + (pcase-dolist (`(,sym . ,binding) context-menu--saved-bindings) (let ((key (vector sym))) (if binding (global-set-key key binding) commit 89c31342a735c631b93ef7d75f3b0672e83f9e95 Author: Mattias Engdegård Date: Fri Aug 20 12:03:20 2021 +0200 Use C-mouse-1 for context menu on NS The Mac platform convention is to use control-left-click for context menus (as a synonym to right-click). * lisp/mouse.el (context-menu--old-bindings): Remove. (context-menu--saved-bindings) (context-menu--bind-mouse, context-menu--reset-bindings): New. (context-menu-mode): Use new functions, with C-mouse-1 as extra binding on NS. diff --git a/lisp/mouse.el b/lisp/mouse.el index d2a5200d8d..4dcc2f28f4 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -440,8 +440,28 @@ the same menu with changes such as added new menu items." `(menu-item ,(purecopy "Context Menu") ignore :filter (lambda (_) (context-menu-map)))) -(defvar context-menu--old-down-mouse-3 nil) -(defvar context-menu--old-mouse-3 nil) +(defvar context-menu--saved-bindings nil + "Alist of bindings to restore when `context-menu-mode' is disabled.") + +(defun context-menu--bind-mouse (click-sym down-sym) + "Enable `context-menu-mode' mouse bindings. +CLICK-SYM and DOWN-SYM are the mouse click and down key symbols to use." + (let ((click (vector click-sym)) + (down (vector down-sym))) + (push (cons click-sym (global-key-binding click)) + context-menu--saved-bindings) + (global-unset-key click) + (push (cons down-sym (global-key-binding down)) + context-menu--saved-bindings) + (global-set-key down context-menu-entry))) + +(defun context-menu--reset-bindings () + "Restore saved `context-menu-mode' bindings." + (pcase-dolist (`(sym . binding) context-menu--saved-bindings) + (let ((key (vector sym))) + (if binding + (global-set-key key binding) + (global-unset-key key))))) (define-minor-mode context-menu-mode "Toggle Context Menu mode. @@ -449,20 +469,13 @@ the same menu with changes such as added new menu items." When Context Menu mode is enabled, clicking the mouse button down-mouse-3 activates the menu whose contents depends on its surrounding context." :global t :group 'mouse - (cond - (context-menu-mode - (setq context-menu--old-mouse-3 (global-key-binding [mouse-3])) - (global-unset-key [mouse-3]) - (setq context-menu--old-down-mouse-3 (global-key-binding [down-mouse-3])) - (global-set-key [down-mouse-3] context-menu-entry)) - (t - (if (not context-menu--old-down-mouse-3) - (global-unset-key [down-mouse-3]) - (global-set-key [down-mouse-3] context-menu--old-down-mouse-3) - (setq context-menu--old-down-mouse-3 nil)) - (when context-menu--old-mouse-3 - (global-set-key [mouse-3] context-menu--old-mouse-3) - (setq context-menu--old-mouse-3 nil))))) + (if context-menu-mode + (progn + (setq context-menu--saved-bindings nil) + (context-menu--bind-mouse 'mouse-3 'down-mouse-3) + (when (featurep 'ns) + (context-menu--bind-mouse 'C-mouse-1 'C-down-mouse-1))) + (context-menu--restore-bindings))) ;; Commands that operate on windows. commit e1ed0c3af182b313f8f1a8f0d50fcda369aaf71c Author: Mattias Engdegård Date: Thu Aug 19 23:15:29 2021 +0200 Fix xref {prev,next}-error target buffer match highlighting extent * lisp/progmodes/xref.el (xref--next-error-function): Bind `xref--current-item` during the call to `xref--show-location` so that `xref-pulse-momentarily` finds the match extent. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index d3780d571f..b6ad485407 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -877,7 +877,8 @@ beginning of the line." ;; it gets reset to that window's point from time to time). (let ((win (get-buffer-window (current-buffer)))) (and win (set-window-point win (point)))) - (xref--show-location (xref-item-location xref) t)) + (let ((xref--current-item xref)) + (xref--show-location (xref-item-location xref) t))) (t (error "No %s xref" (if backward "previous" "next")))))) commit c69b4768d6a8ee57ea5358ae91a33431988b7ba3 Author: Mattias Engdegård Date: Thu Aug 19 11:35:41 2021 +0200 Don't mutate string literal * lisp/obsolete/terminal.el (terminal-escape-map): Rewrite loop in a simpler and more robust way. diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el index 0167a00066..fa89b586a0 100644 --- a/lisp/obsolete/terminal.el +++ b/lisp/obsolete/terminal.el @@ -112,10 +112,9 @@ performance." nil (let ((map (make-sparse-keymap))) (define-key map [t] #'undefined) - (let ((s "0")) - (while (<= (aref s 0) ?9) - (define-key map s #'digit-argument) - (aset s 0 (1+ (aref s 0))))) + (dotimes (i 10) + (let ((s (make-string 1 (+ ?0 i)))) + (define-key map s #'digit-argument))) (define-key map "b" #'switch-to-buffer) (define-key map "o" #'other-window) (define-key map "e" #'te-set-escape-char)