commit f283144658259f209efdef78c576b43832c9c479 (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Wed Sep 11 17:42:24 2024 +0200 Allow to disable symbolic links check in Dired * doc/emacs/dired.texi (Misc Dired Features): * doc/misc/tramp.texi (Frequently Asked Questions): Explain dired-check-symlinks. * etc/NEWS: Describe dired-check-symlinks. Fix typos. * lisp/dired.el (dired-check-symlinks): New defcustom. (dired-font-lock-keywords): Use it. (Bug#73046) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 88638190d7f..246d3e1a4bc 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1817,6 +1817,15 @@ the files in the current directory as well as the available disk space. If you set this to @code{nil}, the available disk space information will not be displayed at all. +@vindex dired-check-symlinks + Dired fontifies the items in the Dired buffer. If the +@code{default-directory} of that buffer is remote, this might be +extensive for symbolic links, because their @code{file-truename} is +evaluated. Set user option @code{dired-check-symlinks} to @code{nil} +for remote directories, which suffer from a slow connection. It can be +declared as connection-local variable to match how a remote system is +connectable (@pxref{Connection Variables}). + @kindex + @r{(Dired)} @findex dired-create-directory The command @kbd{+} (@code{dired-create-directory}) reads a diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 901fce2db39..a0a0a7164fb 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5292,6 +5292,31 @@ connections, apply the following code. @end group @end lisp +@vindex dired-check-symlinks +@item +Disable check for symbolic link validity in @code{dired} buffers. +Emacs fontifies symbolic links in @code{dired} buffers using the +@code{file-truename} operation. This can be slow. Since @w{Emacs +31}, there is a user option which suppresses this. It can be set +connection-local. +@ifinfo +@xref{Connection Variables, , , emacs}. +@end ifinfo + +@lisp +@group +(connection-local-set-profile-variables + 'my-dired-profile + '((dired-check-symlinks . nil))) +@end group + +@group +(connection-local-set-profiles + '(:application tramp :machine "remotehost") + 'my-dired-profile) +@end group +@end lisp + @item Use direct asynchronous processes if possible. diff --git a/etc/NEWS b/etc/NEWS index 1bdbe368846..53ca814b9f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -111,7 +111,7 @@ This hook allows you to control which tab-bar tabs are auto-resized. ** Project --- -*** New command `project-find-file-in-root`. +*** New command 'project-find-file-in-root'. It is equivalent to running ‘project-any-command’ with ‘find-file’. @@ -291,9 +291,9 @@ command attempts to look up and copy the text in-between the hunks. ** php-ts-mode --- -*** 'php-ts-mode-run-php-webserver' can now accept a custom php.ini file. +*** 'php-ts-mode-run-php-webserver' can now accept a custom "php.ini" file. You can use the new optional argument CONFIG when calling -'php-ts-mode-run-php-webserver' to pass an alternative php.ini file to +'php-ts-mode-run-php-webserver' to pass an alternative "php.ini" file to the built-in Web server. Interactively, when invoked with a prefix argument, 'php-ts-mode-run-php-webserver' prompts for the config file as well as for other connection parameters. @@ -316,6 +316,14 @@ changes when supplied with a universal prefix argument via 'C-u': - 'C-u c a' copies all changes from buffer C to buffer A. - 'C-u c b' copies all changes from buffer C to buffer B. +** Dired + ++++ +*** Dired allows to disable checks for symbolic link validity. +Dired fontifies symbolic links in Dired buffers using the +'file-truename' operation. This can be slow for remote directories. +Setting user option 'dired-check-symlinks' to nil disables these checks. + * New Modes and Packages in Emacs 31.1 @@ -364,11 +372,11 @@ If supplied, 'string-pixel-width' will use any face remappings from BUFFER when computing the string's width. --- -*** New macro 'with-work-buffer'. -This macro is similar to the already existing macro `with-temp-buffer', +** New macro 'with-work-buffer'. +This macro is similar to the already existing macro 'with-temp-buffer', except that it does not allocate a new temporary buffer on each call, but tries to reuse those previously allocated (up to a number defined by -the new variable `work-buffer-limit', which defaults to 10). +the new variable 'work-buffer-limit', which defaults to 10). +++ ** 'date-to-time' now defaults to local time. @@ -405,7 +413,7 @@ where a userspace executable loader is required, has been optimized on systems featuring Linux 3.5.0 and above. --- -** NSSpeechRecognitionUsageDescription now included in Info.plist (macOS). +** 'NSSpeechRecognitionUsageDescription' now included in "Info.plist" (macOS). Should Emacs (or any built-in shell) invoke a process using macOS speech recognition APIs, the relevant permission dialog is now displayed, thus allowing Emacs users access to speech recognition utilities. diff --git a/lisp/dired.el b/lisp/dired.el index 0d526dfc376..2bf5a221f4e 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -738,6 +738,13 @@ Subexpression 2 must end right before the \\n.") ;;; Font-lock +(defcustom dired-check-symlinks t + "Whether symlinks are checked for validity. +Set it to nil for remote directories, which suffer from a slow connection." + :type 'boolean + :group 'dired + :version "31.1") + (defvar dired-font-lock-keywords (list ;; @@ -815,11 +822,13 @@ Subexpression 2 must end right before the \\n.") ;; Broken Symbolic link. (list dired-re-sym (list (lambda (end) - (let* ((file (dired-file-name-at-point)) - (truename (ignore-errors (file-truename file)))) - ;; either not existent target or circular link - (and (not (and truename (file-exists-p truename))) - (search-forward-regexp "\\(.+\\) \\(->\\) ?\\(.+\\)" end t)))) + (when (connection-local-value dired-check-symlinks) + (let* ((file (dired-file-name-at-point)) + (truename (ignore-errors (file-truename file)))) + ;; either not existent target or circular link + (and (not (and truename (file-exists-p truename))) + (search-forward-regexp + "\\(.+\\) \\(->\\) ?\\(.+\\)" end t))))) '(dired-move-to-filename) nil '(1 'dired-broken-symlink) @@ -829,24 +838,29 @@ Subexpression 2 must end right before the \\n.") ;; Symbolic link to a directory. (list dired-re-sym (list (lambda (end) - (when-let* ((file (dired-file-name-at-point)) - (truename (ignore-errors (file-truename file)))) - (and (file-directory-p truename) - (search-forward-regexp "\\(.+-> ?\\)\\(.+\\)" end t)))) + (when (connection-local-value dired-check-symlinks) + (when-let* ((file (dired-file-name-at-point)) + (truename (ignore-errors (file-truename file)))) + (and (file-directory-p truename) + (search-forward-regexp + "\\(.+-> ?\\)\\(.+\\)" end t))))) '(dired-move-to-filename) nil '(1 dired-symlink-face) '(2 `(face ,dired-directory-face dired-symlink-filename t)))) ;; - ;; Symbolic link to a non-directory. + ;; Symbolic link to a non-directory. Or no check at all. (list dired-re-sym (list (lambda (end) - (when-let ((file (dired-file-name-at-point))) - (let ((truename (ignore-errors (file-truename file)))) - (and (or (not truename) - (not (file-directory-p truename))) - (search-forward-regexp "\\(.+-> ?\\)\\(.+\\)" - end t))))) + (if (not (connection-local-value dired-check-symlinks)) + (search-forward-regexp + "\\(.+-> ?\\)\\(.+\\)" end t) + (when-let ((file (dired-file-name-at-point))) + (let ((truename (ignore-errors (file-truename file)))) + (and (or (not truename) + (not (file-directory-p truename))) + (search-forward-regexp + "\\(.+-> ?\\)\\(.+\\)" end t)))))) '(dired-move-to-filename) nil '(1 dired-symlink-face) commit 833158c0b78c6dbeacb169076a9899ba7bf45bff Author: Paul Nelson Date: Wed Sep 4 09:24:25 2024 +0200 Add Ediff feature for copying all differences * lisp/vc/ediff-util.el (ediff-diff-to-diff): With universal prefix, copy all differences. * doc/misc/ediff.texi (Quick Help Commands): Document the new feature. * etc/NEWS: Announce the new feature. (Bug#72866) diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index ae107323d9c..5f5074b16b6 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -489,15 +489,17 @@ compares three files simultaneously). @item a @kindex a @emph{In comparison sessions:} -Copies the current difference region (or the region specified as the prefix -to this command) from buffer A to buffer B@. -Ediff saves the old contents of buffer B's region; it can -be restored via the command @kbd{rb}, which see. +Copies the current difference region (or the region specified as the +numerical prefix to this command, or @emph{all} regions with @kbd{C-u} +prefix) from buffer A to buffer B@. Ediff saves the old contents of +buffer B's region; it can be restored via the command @kbd{rb}, which +see. @emph{In merge sessions:} -Copies the current difference region (or the region specified as the prefix -to this command) from buffer A to the merge buffer. The old contents of -this region in buffer C can be restored via the command @kbd{r}. +Copies the current difference region (or the region specified as the +numerical prefix to this command, or @emph{all} regions with @kbd{C-u} +prefix) from buffer A to the merge buffer. The old contents of this +region in buffer C can be restored via the command @kbd{r}. @item b @kindex b @@ -511,11 +513,12 @@ be reinstated via the command @kbd{ra} in comparison sessions and @item ab @kindex ab -Copies the current difference region (or the region specified as the prefix -to this command) from buffer A to buffer B@. This (and the next five) -command is enabled only in sessions that compare three files -simultaneously. The old region in buffer B is saved and can be restored -via the command @kbd{rb}. +Copies the current difference region (or the region specified as the +numerical prefix to this command, or @emph{all} regions with @kbd{C-u} +prefix) from buffer A to buffer B@. This (and the next five) command is +enabled only in sessions that compare three files simultaneously. The +old region in buffer B is saved and can be restored via the command +@kbd{rb}. @item ac @kindex ac Copies the difference region from buffer A to buffer C@. diff --git a/etc/NEWS b/etc/NEWS index 8589931684f..1bdbe368846 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -298,6 +298,24 @@ the built-in Web server. Interactively, when invoked with a prefix argument, 'php-ts-mode-run-php-webserver' prompts for the config file as well as for other connection parameters. +** Ediff + ++++ +*** Ediff's copy commands now apply to all changes with 'C-u' prefix. +The Ediff copy commands, bound to 'a', 'b', 'ab', etc., now copy all +changes when supplied with a universal prefix argument via 'C-u': + +- 'C-u a' copies all changes from buffer A to buffer B (in 2-way diff) + or to buffer C (in 3-way diff or merge). +- 'C-u b' copies all changes from buffer B to buffer A (in 2-way diff) + or to buffer C (in 3-way diff or merge). +- 'C-u a b' copies all changes from buffer A to buffer B. +- 'C-u b a' copies all changes from buffer B to buffer A. +- 'C-u a c' copies all changes from buffer A to buffer C. +- 'C-u b c' copies all changes from buffer B to buffer C. +- 'C-u c a' copies all changes from buffer C to buffer A. +- 'C-u c b' copies all changes from buffer C to buffer B. + * New Modes and Packages in Emacs 31.1 diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 597d8a5e643..6038f3eae30 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1890,8 +1890,8 @@ current point position in the specified buffer." (defun ediff-diff-to-diff (arg &optional keys) "Copy buffer-X'th difference region to buffer Y (X,Y are A, B, or C). -With numerical prefix argument ARG, copy the difference specified -in the arg. +With numerical prefix argument ARG, copy the difference specified in the +arg. With prefix `\\[universal-argument]', copy all differences. Otherwise, copy the difference given by `ediff-current-difference'. This command assumes it is bound to a 2-character key sequence, `ab', `ba', `ac', etc., which is used to determine the types of buffers to be used for @@ -1904,17 +1904,23 @@ command keys." (interactive "P") (ediff-barf-if-not-control-buffer) (or keys (setq keys (this-command-keys))) - (if (eq arg '-) (setq arg -1)) ; translate neg arg to -1 - (if (numberp arg) (ediff-jump-to-difference arg)) - - (let* ((char1 (aref keys 0)) - (char2 (aref keys 1)) - ediff-verbose-p) - (ediff-copy-diff ediff-current-difference - (ediff-char-to-buftype char1) - (ediff-char-to-buftype char2)) - ;; recenter with rehighlighting, but no messages - (ediff-recenter))) + (if (equal arg '(4)) + ;; copy all differences with `C-u' prefix + (let ((n 0)) + (while (ediff-valid-difference-p n) + (ediff-diff-to-diff (1+ n) keys) + (setq n (1+ n)))) + (if (eq arg '-) (setq arg -1)) ; translate neg arg to -1 + (if (numberp arg) (ediff-jump-to-difference arg)) + + (let* ((char1 (aref keys 0)) + (char2 (aref keys 1)) + ediff-verbose-p) + (ediff-copy-diff ediff-current-difference + (ediff-char-to-buftype char1) + (ediff-char-to-buftype char2)) + ;; recenter with rehighlighting, but no messages + (ediff-recenter)))) (defun ediff-copy-A-to-B (arg) "Copy ARGth difference region from buffer A to B. commit fc3a7f45292b9a7be95fdefd24fedb7e8f564d1c Author: Martin Rudalics Date: Wed Sep 11 10:36:14 2024 +0200 For minibuffer windows record minibuffers only (Bug#72487) * src/minibuf.c (zip_minibuffer_stacks): Use wset type functions. Call 'record-window-buffer' instead of 'push-window-buffer-onto-prev' to handle all sorts of buffers shown in minibuffer windows in a uniform way. (read_minibuf): Call 'record-window-buffer' instead of 'push-window-buffer-onto-prev' for same reason as previous. * lisp/calculator.el (calculator-update-display) (calculator-save-and-quit): Make sure calculator buffer is live before operating on it. * lisp/window.el (record-window-buffer): Handle case where WINDOW is a minibuffer window: Unconditionally remove WINDOW's buffer from WINDOW's list of previous buffers and push it if and only if it is a live minibuffer (Bug#72487). Do not run 'buffer-list-update-hook' if WINDOW is a minibuffer window. (push-window-buffer-onto-prev): Make it an alias of 'record-window-buffer' so it will run the latter's checks. (replace-buffer-in-windows): Handle minibuffer windows and rewrite doc-string accordingly. * doc/lispref/windows.texi (Buffers and Windows): Explain handling of minibuffer windows in 'replace-buffer-in-windows'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 656a44dfcbf..541c91ddae2 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2353,6 +2353,12 @@ buffers (@pxref{Window History}) of all windows (including dead windows that are only referenced by window configurations) and remove any @code{quit-restore} or @code{quit-restore-prev} parameters (@pxref{Window Parameters}) referencing that buffer. + +This function does not replace the buffer specified by +@var{buffer-or-name} in any minibuffer window showing it, nor does it +delete minibuffer windows or minibuffer frames. It removes, however, +that buffer from the lists of previous and next buffers of all +minibuffer windows. @end deffn By default, @code{replace-buffer-in-windows} deletes only windows diff --git a/lisp/calculator.el b/lisp/calculator.el index ef1e6d8dbc3..a9fe76259a8 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -1059,49 +1059,50 @@ the `left' or `right' when one of the standard modes is used." (defun calculator-update-display (&optional force) "Update the display. If optional argument FORCE is non-nil, don't use the cached string." - (set-buffer calculator-buffer) - ;; update calculator-stack-display - (when (or force (not (eq (car calculator-stack-display) - calculator-stack))) - (setq calculator-stack-display - (cons calculator-stack - (if calculator-stack - (concat - (let ((calculator-displayer - (if (and calculator-displayers - (= 1 (length calculator-stack))) - ;; customizable display for a single value - (caar calculator-displayers) - calculator-displayer))) - (mapconcat 'calculator-number-to-string - (reverse calculator-stack) - " ")) - " " - (and calculator-display-fragile - calculator-saved-list - ;; Hack: use `eq' to compare the number: it's a - ;; flonum, so `eq' means that its the actual - ;; number rather than a computation that had an - ;; equal result (eg, enter 1,3,2, use "v" to see - ;; the average -- it now shows "2" instead of - ;; "2 [3]"). - (eq (car calculator-stack) - (nth calculator-saved-ptr - calculator-saved-list)) - (if (= 0 calculator-saved-ptr) - (format "[%s]" (length calculator-saved-list)) - (format "[%s/%s]" - (- (length calculator-saved-list) - calculator-saved-ptr) - (length calculator-saved-list))))) - "")))) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (calculator-get-display))) - (set-buffer-modified-p nil) - (goto-char (if calculator-display-fragile - (1+ (length calculator-prompt)) - (1- (point))))) + (when (buffer-live-p calculator-buffer) + (set-buffer calculator-buffer) + ;; update calculator-stack-display + (when (or force (not (eq (car calculator-stack-display) + calculator-stack))) + (setq calculator-stack-display + (cons calculator-stack + (if calculator-stack + (concat + (let ((calculator-displayer + (if (and calculator-displayers + (= 1 (length calculator-stack))) + ;; customizable display for a single value + (caar calculator-displayers) + calculator-displayer))) + (mapconcat 'calculator-number-to-string + (reverse calculator-stack) + " ")) + " " + (and calculator-display-fragile + calculator-saved-list + ;; Hack: use `eq' to compare the number: it's a + ;; flonum, so `eq' means that its the actual + ;; number rather than a computation that had an + ;; equal result (eg, enter 1,3,2, use "v" to see + ;; the average -- it now shows "2" instead of + ;; "2 [3]"). + (eq (car calculator-stack) + (nth calculator-saved-ptr + calculator-saved-list)) + (if (= 0 calculator-saved-ptr) + (format "[%s]" (length calculator-saved-list)) + (format "[%s/%s]" + (- (length calculator-saved-list) + calculator-saved-ptr) + (length calculator-saved-list))))) + "")))) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (calculator-get-display))) + (set-buffer-modified-p nil) + (goto-char (if calculator-display-fragile + (1+ (length calculator-prompt)) + (1- (point)))))) ;;;--------------------------------------------------------------------- ;;; Stack computations @@ -1553,17 +1554,18 @@ a multiplication." (defun calculator-quit () "Quit calculator." (interactive) - (set-buffer calculator-buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (unless calculator-electric-mode - (ignore-errors - (while (get-buffer-window calculator-buffer) - (delete-window (get-buffer-window calculator-buffer))))) - (kill-buffer calculator-buffer) - (message "Calculator done.") - (if calculator-electric-mode - (throw 'calculator-done nil) ; will kill the buffer - (setq calculator-buffer nil))) + (when (buffer-live-p calculator-buffer) + (set-buffer calculator-buffer) + (let ((inhibit-read-only t)) (erase-buffer)) + (unless calculator-electric-mode + (ignore-errors + (while (get-buffer-window calculator-buffer) + (delete-window (get-buffer-window calculator-buffer))))) + (kill-buffer calculator-buffer) + (message "Calculator done.") + (if calculator-electric-mode + (throw 'calculator-done nil) ; will kill the buffer + (setq calculator-buffer nil)))) (defun calculator-save-and-quit () "Quit the calculator, saving the result on the `kill-ring'." diff --git a/lisp/window.el b/lisp/window.el index f4226fa4428..07ea9584908 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4469,75 +4469,86 @@ This may be a useful alternative binding for \\[delete-other-windows] ;;; Windows and buffers. -;; `prev-buffers' and `next-buffers' are two reserved window slots used +;; 'prev-buffers' and 'next-buffers' are two reserved window slots used ;; for (1) determining which buffer to show in the window when its ;; buffer shall be buried or killed and (2) which buffer to show for -;; `switch-to-prev-buffer' and `switch-to-next-buffer'. +;; 'switch-to-prev-buffer' and 'switch-to-next-buffer'. -;; `prev-buffers' consists of +;; 'prev-buffers' consists of ;; triples. The entries on this list are ordered by the time their ;; buffer has been removed from the window, the most recently removed ;; buffer's entry being first. The window-start and window-point -;; components are `window-start' and `window-point' at the time the +;; components are 'window-start' and 'window-point' at the time the ;; buffer was removed from the window which implies that the entry must -;; be added when `set-window-buffer' removes the buffer from the window. +;; be added when 'set-window-buffer' removes the buffer from the window. -;; `next-buffers' is the list of buffers that have been replaced -;; recently by `switch-to-prev-buffer'. These buffers are the least -;; preferred candidates of `switch-to-prev-buffer' and the preferred -;; candidates of `switch-to-next-buffer' to switch to. This list is +;; 'next-buffers' is the list of buffers that have been replaced +;; recently by 'switch-to-prev-buffer'. These buffers are the least +;; preferred candidates of 'switch-to-prev-buffer' and the preferred +;; candidates of 'switch-to-next-buffer' to switch to. This list is ;; reset to nil by any action changing the window's buffer with the -;; exception of `switch-to-prev-buffer' and `switch-to-next-buffer'. -;; `switch-to-prev-buffer' pushes the buffer it just replaced on it, -;; `switch-to-next-buffer' pops the last pushed buffer from it. - -;; Both `prev-buffers' and `next-buffers' may reference killed buffers -;; if such a buffer was killed while the window was hidden within a -;; window configuration. Such killed buffers get removed whenever -;; `switch-to-prev-buffer' or `switch-to-next-buffer' encounter them. - -;; The following function is called by `set-window-buffer' _before_ it -;; replaces the buffer of the argument window with the new buffer. -(defun push-window-buffer-onto-prev (&optional window) - "Push entry for WINDOW's buffer onto WINDOW's prev-buffers list. -WINDOW must be a live window and defaults to the selected one. - -Any duplicate entries for the buffer in the list are removed." +;; exception of 'switch-to-prev-buffer' and 'switch-to-next-buffer'. +;; 'switch-to-prev-buffer' pushes the buffer it just replaced on it, +;; 'switch-to-next-buffer' pops the last pushed buffer from it. + +;; The following function is called by 'set-window-buffer' _before_ it +;; replaces the buffer of the argument window with the new buffer. It +;; does not record a non-minibuffer buffer (like the one created by +;; 'calculator' in Electric mode) in a minibuffer window since the code +;; in minibuf.c cannot handle that. The minibuf.c code calls this +;; function exclusively to arrange minibuffers shown in minibuffer +;; windows. +(defun record-window-buffer (&optional window) + "Record WINDOW's buffer. +Add the buffer currently shown in WINDOW to the list of WINDOW's +previous buffers. WINDOW must be a live window and defaults to the +selected one. + +If WINDOW is not a minibuffer window, do not record insignificant +buffers (buffers whose name starts with a space). If WINDOW is a +minibuffer window, record its buffer if and only if that buffer is a +live minibuffer (`minibufferp' with LIVE argument non-nil must return +non-nil for it). + +Run `buffer-list-update-hook' if and only if WINDOW is not a minibuffer +window." (let* ((window (window-normalize-window window t)) + (mini (window-minibuffer-p window)) (buffer (window-buffer window)) - (w-list (window-prev-buffers window)) - (entry (assq buffer w-list))) + (prev-buffers (window-prev-buffers window)) + (entry (assq buffer prev-buffers))) (when entry - (setq w-list (assq-delete-all buffer w-list))) - (let ((start (window-start window)) - (point (window-point window))) - (setq entry - (cons buffer - (with-current-buffer buffer - (if entry - ;; We have an entry, update marker positions. - (list (set-marker (nth 1 entry) start) - (set-marker (nth 2 entry) point)) - (list (copy-marker start) - (copy-marker - ;; Preserve window-point-insertion-type - ;; (Bug#12855) - point window-point-insertion-type)))))) - (set-window-prev-buffers window (cons entry w-list))))) + (setq prev-buffers (assq-delete-all buffer prev-buffers))) -(defun record-window-buffer (&optional window) - "Record WINDOW's buffer. -WINDOW must be a live window and defaults to the selected one." - (let* ((window (window-normalize-window window t)) - (buffer (window-buffer window))) ;; Reset WINDOW's next buffers. If needed, they are resurrected by ;; `switch-to-prev-buffer' and `switch-to-next-buffer'. (set-window-next-buffers window nil) - ;; Don't record insignificant buffers. - (when (not (eq (aref (buffer-name buffer) 0) ?\s)) - (push-window-buffer-onto-prev window) - (run-hooks 'buffer-list-update-hook)))) + ;; For minibuffer windows record live minibuffers only. For normal + ;; windows do not record insignificant buffers. + (when (if mini + (minibufferp buffer t) + (not (eq (aref (buffer-name buffer) 0) ?\s))) + (let ((start (window-start window)) + (point (window-point window))) + (setq entry + (cons buffer + (with-current-buffer buffer + (if entry + ;; We have an entry, update marker positions. + (list (set-marker (nth 1 entry) start) + (set-marker (nth 2 entry) point)) + (list (copy-marker start) + (copy-marker + ;; Preserve window-point-insertion-type + ;; (Bug#12855) + point window-point-insertion-type)))))) + (set-window-prev-buffers window (cons entry prev-buffers)) + + (unless mini + (run-hooks 'buffer-list-update-hook)))))) + +(defalias 'push-window-buffer-onto-prev 'record-window-buffer) (defun unrecord-window-buffer (&optional window buffer all) "Unrecord BUFFER in WINDOW. @@ -5160,10 +5171,19 @@ parameters naming it." ;; If a window doesn't show BUFFER, unrecord BUFFER in it. (unrecord-window-buffer window buffer t))))) +;; Conceptually, 'replace-buffer-in-windows' would not have to touch the +;; list of previous buffers of a minibuffer window: As a rule, +;; minibuffers are never deleted and any other buffers shown in a +;; minibuffer window are not recorded by 'record-window'. To be on the +;; safe side, 'replace-buffer-in-windows' now scans minibuffer windows +;; too to make sure that any killed buffer gets removed from all lists +;; of previous and next buffers. 'replace-buffer-in-windows' still does +;; _not_ replace the buffer itself in any minibuffer window showing it. +;; That case is still handled only in 'kill-buffer' itself. (defun replace-buffer-in-windows (&optional buffer-or-name) "Replace BUFFER-OR-NAME with some other buffer in all windows showing it. BUFFER-OR-NAME may be a buffer or the name of an existing buffer and -defaults to the current buffer. Minibuffer windows are not considered. +defaults to the current buffer. If the option `kill-buffer-quit-windows' is nil, behave as follows: With the exception of side windows, when a window showing BUFFER-OR-NAME is @@ -5180,21 +5200,29 @@ In either case, remove the buffer denoted by BUFFER-OR-NAME from the lists of previous and next buffers of all windows and remove any `quit-restore' or `quit-restore-prev' parameters mentioning it. +This function does not replace the buffer specified by BUFFER-OR-NAME in +any minibuffer window showing it, nor does it delete minibuffer windows +or minibuffer frames. It removes, however, that buffer from the lists +of previous and next buffers of all minibuffer windows. + If, for any window showing BUFFER-OR-NAME running the abnormal hook `window-deletable-functions' returns nil, do not delete that window but show some other buffer in that window. -This function is called by `kill-buffer' which kills the buffer -specified by `buffer-or-name' afterwards. It never kills a buffer by -itself." +This function is called by `kill-buffer' which effectively kills the +buffer specified by `buffer-or-name' afterwards. It never kills a +buffer by itself." (interactive "bBuffer to replace: ") (let ((buffer (window-normalize-buffer buffer-or-name))) - ;; Scan all windows. We have to unrecord BUFFER-OR-NAME in those - ;; not showing it. - (dolist (window (window-list-1 nil nil t)) + ;; Scan all windows including minibuffer windows. We have to + ;; unrecord BUFFER-OR-NAME even in those not showing it. + (dolist (window (window-list-1 nil t t)) (when (eq (window-buffer window) buffer) - (if kill-buffer-quit-windows - (quit-restore-window window 'killing) + (cond + ((window-minibuffer-p window)) + (kill-buffer-quit-windows + (quit-restore-window window 'killing)) + (t (let ((dedicated-side (eq (window-dedicated-p window) 'side))) (when (or dedicated-side (not (window--delete window t 'kill))) ;; Switch to another buffer in that window. @@ -5212,7 +5240,7 @@ itself." ;; element of the parameter, 'quit-restore-window' cannot ;; possibly show BUFFER instead; so this parameter becomes ;; useless too. - (unrecord-window-buffer window buffer t))))) + (unrecord-window-buffer window buffer t)))))) (defcustom quit-window-hook nil "Hook run before performing any other actions in the `quit-window' command." diff --git a/src/minibuf.c b/src/minibuf.c index f16880011f7..1f94e0e650e 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -160,16 +160,15 @@ zip_minibuffer_stacks (Lisp_Object dest_window, Lisp_Object source_window) set_window_buffer (dest_window, sw->contents, 0, 0); Fset_window_start (dest_window, Fwindow_start (source_window), Qnil); Fset_window_point (dest_window, Fwindow_point (source_window)); - dw->prev_buffers = sw->prev_buffers; + wset_prev_buffers (dw, sw->prev_buffers); set_window_buffer (source_window, nth_minibuffer (0), 0, 0); - sw->prev_buffers = Qnil; + wset_prev_buffers (sw, Qnil); return; } - if (live_minibuffer_p (dw->contents)) - call1 (Qpush_window_buffer_onto_prev, dest_window); - if (live_minibuffer_p (sw->contents)) - call1 (Qpush_window_buffer_onto_prev, source_window); + call1 (Qrecord_window_buffer, dest_window); + call1 (Qrecord_window_buffer, source_window); + acc = merge_c (dw->prev_buffers, sw->prev_buffers, minibuffer_ent_greater); if (!NILP (acc)) @@ -180,8 +179,9 @@ zip_minibuffer_stacks (Lisp_Object dest_window, Lisp_Object source_window) Fset_window_start (dest_window, Fcar (Fcdr (d_ent)), Qnil); Fset_window_point (dest_window, Fcar (Fcdr (Fcdr (d_ent)))); } - dw->prev_buffers = acc; - sw->prev_buffers = Qnil; + + wset_prev_buffers (dw, acc); + wset_prev_buffers (sw, Qnil); set_window_buffer (source_window, nth_minibuffer (0), 0, 0); } @@ -688,8 +688,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Fframe_first_window (MB_frame), Qnil); } MB_frame = XWINDOW (XFRAME (selected_frame)->minibuffer_window)->frame; - if (live_minibuffer_p (XWINDOW (minibuf_window)->contents)) - call1 (Qpush_window_buffer_onto_prev, minibuf_window); + + call1 (Qrecord_window_buffer, minibuf_window); record_unwind_protect_void (minibuffer_unwind); if (read_minibuffer_restore_windows) diff --git a/src/window.c b/src/window.c index 35092ddd582..34968ac824f 100644 --- a/src/window.c +++ b/src/window.c @@ -3647,9 +3647,17 @@ replace_buffer_in_windows (Lisp_Object buffer) call1 (Qreplace_buffer_in_windows, buffer); } -/* If BUFFER is shown in a window, safely replace it with some other - buffer in all windows of all frames, even those on other keyboards. */ - +/** If BUFFER is shown in any window, safely replace it with some other + buffer in all windows of all frames, even those on other keyboards. + Do not delete any window. + + This function is called by Fkill_buffer when it detects that + replacing BUFFER in some window showing BUFFER has failed. It + assumes that ‘replace-buffer-in-windows’ has removed any entry + referencing BUFFER from any window's lists of previous and next + buffers and that window's ‘quit-restore’ and 'quit-restore-prev' + parameters. +*/ void replace_buffer_in_windows_safely (Lisp_Object buffer) { commit 74ea24233ca281b19c3e3d2552621ceac30dfc48 Author: Robert Pluim Date: Wed Sep 11 10:00:34 2024 +0200 ; * test/lisp/gnus/gnus-icalendar-tests.el: remove unneeded unwind-protect diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el index 72f1e660077..9385f2ab7a6 100644 --- a/test/lisp/gnus/gnus-icalendar-tests.el +++ b/test/lisp/gnus/gnus-icalendar-tests.el @@ -257,7 +257,8 @@ END:VCALENDAR" (list "participant@anoncompany.com")))) (ert-deftest gnus-icalendar-accept-with-comment () "" - (let ((event "BEGIN:VEVENT + (let ((event "\ +BEGIN:VEVENT DTSTART;TZID=Europe/Berlin:20200915T140000 DTEND;TZID=Europe/Berlin:20200915T143000 RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE @@ -276,23 +277,22 @@ SUMMARY:Casual coffee talk TRANSP:OPAQUE END:VEVENT") (icalendar-identities '("participant@anoncompany.com"))) - (unwind-protect - (progn - (let* ((reply (with-temp-buffer - (insert event) - (gnus-icalendar-event-reply-from-buffer - (current-buffer) - 'accepted - icalendar-identities - "Can not stay long.")))) - (should (string-match "^ATTENDEE;.*?\\(PARTSTAT=[^;]+\\)" reply)) - (should (string-equal (match-string 1 reply) "PARTSTAT=ACCEPTED")) - (should (string-match "^COMMENT:\\(.*\\)$" reply)) - (should (string-equal (match-string 1 reply) "Can not stay long."))))))) + (let* ((reply (with-temp-buffer + (insert event) + (gnus-icalendar-event-reply-from-buffer + (current-buffer) + 'accepted + icalendar-identities + "Can not stay long.")))) + (should (string-match "^ATTENDEE;.*?\\(PARTSTAT=[^;]+\\)" reply)) + (should (string-equal (match-string 1 reply) "PARTSTAT=ACCEPTED")) + (should (string-match "^COMMENT:\\(.*\\)$" reply)) + (should (string-equal (match-string 1 reply) "Can not stay long."))))) (ert-deftest gnus-icalendar-decline-without-changing-comment () "" - (let ((event "BEGIN:VEVENT + (let ((event "\ +BEGIN:VEVENT DTSTART;TZID=Europe/Berlin:20200915T140000 DTEND;TZID=Europe/Berlin:20200915T143000 RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE @@ -312,20 +312,18 @@ SUMMARY:Casual coffee talk TRANSP:OPAQUE END:VEVENT") (icalendar-identities '("participant@anoncompany.com"))) - (unwind-protect - (progn - (let* ((reply (with-temp-buffer - (insert event) - (gnus-icalendar-event-reply-from-buffer - (current-buffer) - 'declined - icalendar-identities - nil)))) - (should (string-match "^ATTENDEE;.*?\\(PARTSTAT=[^;]+\\)" reply)) - (should (string-equal (match-string 1 reply) "PARTSTAT=DECLINED")) - (should (string-match "^COMMENT:\\(.*\\)$" reply)) - (should (string-equal (match-string 1 reply) "Only available at 2pm")) - ))))) + (let* ((reply (with-temp-buffer + (insert event) + (gnus-icalendar-event-reply-from-buffer + (current-buffer) + 'declined + icalendar-identities + nil)))) + (should (string-match "^ATTENDEE;.*?\\(PARTSTAT=[^;]+\\)" reply)) + (should (string-equal (match-string 1 reply) "PARTSTAT=DECLINED")) + (should (string-match "^COMMENT:\\(.*\\)$" reply)) + (should (string-equal (match-string 1 reply) "Only available at 2pm")) + ))) (provide 'gnus-icalendar-tests) ;;; gnus-icalendar-tests.el ends here commit 8332b4dd07a43d09ff8eed7097873d9ac4d5afc8 Author: fpi Date: Wed Aug 28 18:33:20 2024 +0200 Allow comments to organizer in icalendar event replies (Bug#72831) * lisp/gnus/gnus-icalendar.el (gnus-icalendar-event--build-reply-event-body): Add optional COMMENT argument to be inserted into the reply. (gnus-icalendar-event-reply-from-buffer): Add COMMENT argument to be passed through to gnus-icalendar-event--build-reply-event-body (gnus-icalendar-reply-accept, gnus-icalendar-reply-tentative, gnus-icalendar-reply-decline): If interactively called with a prefix argument ask user for a COMMENT to add to the reply. * test/lisp/gnus/gnus-icalendar-tests.el (gnus-icalendar-accept-with-comment, gnus-icalendar-decline-without-changing-comment): New tests. diff --git a/etc/NEWS b/etc/NEWS index c6f8b0062e4..8589931684f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -139,6 +139,14 @@ exactly below the text after the prefix on the first line. If 'whitespace-style' includes 'missing-newline-at-eof' (which is the default), the 'whitespace-cleanup' function will now add the newline. +** Gnus + +--- +*** Replying to icalendar events now supports specifying a comment. +When called with a prefix argument, accepting, declining, or tentatively +accepting an icalendar event will prompt for a comment to add to the +response. + ** Eshell --- diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index af7284b88e8..0d0827b3890 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -309,7 +309,7 @@ status will be retrieved from the first matching attendee record." ;;; gnus-icalendar-event-reply ;;; -(defun gnus-icalendar-event--build-reply-event-body (ical-request status identities) +(defun gnus-icalendar-event--build-reply-event-body (ical-request status identities &optional comment) (let ((summary-status (capitalize (symbol-name status))) (attendee-status (upcase (symbol-name status))) reply-event-lines) @@ -319,6 +319,10 @@ status will be retrieved from the first matching attendee record." (if (string-match "^[^:]+:" line) (replace-match (format "\\&%s: " summary-status) t nil line) line)) + (update-comment + (line) + (if comment (format "COMMENT:%s" comment) + line)) (update-dtstamp () (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) (attendee-matches-identity @@ -341,6 +345,7 @@ status will be retrieved from the first matching attendee record." (cond ((string= key "ATTENDEE") (update-attendee-status line)) ((string= key "SUMMARY") (update-summary line)) + ((string= key "COMMENT") (update-comment line)) ((string= key "DTSTAMP") (update-dtstamp)) ((member key '("ORGANIZER" "DTSTART" "DTEND" "LOCATION" "DURATION" "SEQUENCE" @@ -363,16 +368,27 @@ status will be retrieved from the first matching attendee record." attendee-status user-full-name user-mail-address) reply-event-lines)) + ;; add comment line if not existing + (when (and comment + (not (gnus-icalendar-find-if + (lambda (x) + (string-match "^COMMENT" x)) + reply-event-lines))) + (push (format "COMMENT:%s" comment) reply-event-lines)) + (mapconcat #'identity `("BEGIN:VEVENT" ,@(nreverse reply-event-lines) "END:VEVENT") "\n")))) -(defun gnus-icalendar-event-reply-from-buffer (buf status identities) +(defun gnus-icalendar-event-reply-from-buffer (buf status identities &optional comment) "Build a calendar event reply for request contained in BUF. The reply will have STATUS (`accepted', `tentative' or `declined'). The reply will be composed for attendees matching any entry -on the IDENTITIES list." +on the IDENTITIES list. +Optional argument COMMENT will be placed in the comment field of the +reply. +" (cl-labels ((extract-block (blockname) @@ -396,7 +412,7 @@ on the IDENTITIES list." "PRODID:Gnus" "VERSION:2.0" zone - (gnus-icalendar-event--build-reply-event-body event status identities) + (gnus-icalendar-event--build-reply-event-body event status identities comment) "END:VCALENDAR"))) (mapconcat #'identity (delq nil contents) "\n")))))) @@ -878,13 +894,13 @@ These will be used to retrieve the RSVP information from ical events." (insert "Subject: " subject) (message-send-and-exit)))) -(defun gnus-icalendar-reply (data) +(defun gnus-icalendar-reply (data &optional comment) (let* ((handle (car data)) (status (cadr data)) (event (caddr data)) (reply (gnus-icalendar-with-decoded-handle handle (gnus-icalendar-event-reply-from-buffer - (current-buffer) status (gnus-icalendar-identities)))) + (current-buffer) status (gnus-icalendar-identities) comment))) (organizer (gnus-icalendar-event:organizer event))) (when reply @@ -1009,25 +1025,37 @@ These will be used to retrieve the RSVP information from ical events." (when data (gnus-icalendar-save-part data)))) -(defun gnus-icalendar-reply-accept () - "Accept invitation in the current article." - (interactive nil gnus-article-mode gnus-summary-mode) +(defun gnus-icalendar-reply-accept (&optional comment-p) + "Accept invitation in the current article. + +Optional argument COMMENT-P non-nil (interactively `\\[universal-argument]') +means prompt for a comment to include in the reply." + (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer - (gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event)) + (gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event) + (when comment-p (read-string "Comment: "))) (setq-local gnus-icalendar-reply-status 'accepted))) -(defun gnus-icalendar-reply-tentative () - "Send tentative response to invitation in the current article." - (interactive nil gnus-article-mode gnus-summary-mode) +(defun gnus-icalendar-reply-tentative (&optional comment-p) + "Send tentative response to invitation in the current article. + +Optional argument COMMENT-P non-nil (interactively `\\[universal-argument]') +means prompt for a comment to include in the reply." + (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer - (gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event)) + (gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event) + (when comment-p (read-string "Comment: "))) (setq-local gnus-icalendar-reply-status 'tentative))) -(defun gnus-icalendar-reply-decline () - "Decline invitation in the current article." - (interactive nil gnus-article-mode gnus-summary-mode) +(defun gnus-icalendar-reply-decline (&optional comment-p) + "Decline invitation in the current article. + +Optional argument COMMENT-P non-nil (interactively `\\[universal-argument]') +means prompt for a comment to include in the reply." + (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer - (gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event)) + (gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event) + (when comment-p (read-string "Comment: "))) (setq-local gnus-icalendar-reply-status 'declined))) (defun gnus-icalendar-event-export () diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el index 08c85013d17..72f1e660077 100644 --- a/test/lisp/gnus/gnus-icalendar-tests.el +++ b/test/lisp/gnus/gnus-icalendar-tests.el @@ -255,5 +255,77 @@ END:VCALENDAR" (list "participant@anoncompany.com")))) <2020-09-21 14:00-14:30 +1w>"))) (setenv "TZ" tz)))) +(ert-deftest gnus-icalendar-accept-with-comment () + "" + (let ((event "BEGIN:VEVENT +DTSTART;TZID=Europe/Berlin:20200915T140000 +DTEND;TZID=Europe/Berlin:20200915T143000 +RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE +DTSTAMP:20200915T120627Z +ORGANIZER;CN=anon@anoncompany.com:mailto:anon@anoncompany.com +UID:7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com +ATTENDEE;CUTYPE=INDIVIDUAL;PARTSTAT=NEEDS-ACTION;RSVP=TRUE + ;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com +CREATED:20200325T095723Z +DESCRIPTION:Coffee talk +LAST-MODIFIED:20200915T120623Z +LOCATION: +SEQUENCE:0 +STATUS:CONFIRMED +SUMMARY:Casual coffee talk +TRANSP:OPAQUE +END:VEVENT") + (icalendar-identities '("participant@anoncompany.com"))) + (unwind-protect + (progn + (let* ((reply (with-temp-buffer + (insert event) + (gnus-icalendar-event-reply-from-buffer + (current-buffer) + 'accepted + icalendar-identities + "Can not stay long.")))) + (should (string-match "^ATTENDEE;.*?\\(PARTSTAT=[^;]+\\)" reply)) + (should (string-equal (match-string 1 reply) "PARTSTAT=ACCEPTED")) + (should (string-match "^COMMENT:\\(.*\\)$" reply)) + (should (string-equal (match-string 1 reply) "Can not stay long."))))))) + +(ert-deftest gnus-icalendar-decline-without-changing-comment () + "" + (let ((event "BEGIN:VEVENT +DTSTART;TZID=Europe/Berlin:20200915T140000 +DTEND;TZID=Europe/Berlin:20200915T143000 +RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE +DTSTAMP:20200915T120627Z +ORGANIZER;CN=anon@anoncompany.com:mailto:anon@anoncompany.com +UID:7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com +ATTENDEE;CUTYPE=INDIVIDUAL;PARTSTAT=NEEDS-ACTION;RSVP=TRUE + ;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com +CREATED:20200325T095723Z +DESCRIPTION:Coffee talk +LAST-MODIFIED:20200915T120623Z +COMMENT:Only available at 2pm +LOCATION: +SEQUENCE:0 +STATUS:CONFIRMED +SUMMARY:Casual coffee talk +TRANSP:OPAQUE +END:VEVENT") + (icalendar-identities '("participant@anoncompany.com"))) + (unwind-protect + (progn + (let* ((reply (with-temp-buffer + (insert event) + (gnus-icalendar-event-reply-from-buffer + (current-buffer) + 'declined + icalendar-identities + nil)))) + (should (string-match "^ATTENDEE;.*?\\(PARTSTAT=[^;]+\\)" reply)) + (should (string-equal (match-string 1 reply) "PARTSTAT=DECLINED")) + (should (string-match "^COMMENT:\\(.*\\)$" reply)) + (should (string-equal (match-string 1 reply) "Only available at 2pm")) + ))))) + (provide 'gnus-icalendar-tests) ;;; gnus-icalendar-tests.el ends here