commit c3a76935fa63b0cb2c25f7ecbcd5402b4fb2ef7e (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Mon Jul 26 09:55:30 2021 +0200 Adapt tramp-sudoedit.el for better testing * doc/misc/tramp.texi (Bug Reports): Revert last change. Mention exception for sudoedit. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command): Let-bind `tramp-cache-read-persistent-data' for better password handling. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 17302ddbf2..5672648b42 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4255,16 +4255,9 @@ test, @ref{Cleanup remote connections}. Alternatively, and often better for analysis, reproduce the problem in a clean Emacs session started with @command{emacs -Q}. Then, @value{tramp} does not load the persistency file (@pxref{Connection caching}), and it does not use -passwords from @file{auth-source.el} (@pxref{Password handling}). If -you really need a password cache, for example for the -@option{sudoedit} method, call - -@smallexample -emacs -Q -l tramp \ - --eval '(setq tramp-cache-read-persistent-data t)' \ - --eval '(tramp-cleanup-all-connections)' -@end smallexample - +passwords from @file{auth-source.el} (@pxref{Password handling}). The +latter does not happen for the @option{sudoedit} method, otherwise it +would be unusable. When including @value{tramp}'s messages in the bug report, increase the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index e4d90dde70..5895f1d25b 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -817,6 +817,9 @@ in case of error, t otherwise." (tramp-compat-flatten-tree args)))) ;; We suppress the messages `Waiting for prompts from remote shell'. (tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose)) + ;; The password shall be cached also in case of "emacs -Q". + ;; See `tramp-process-actions'. + (tramp-cache-read-persistent-data t) ;; We do not want to save the password. auth-source-save-behavior) (tramp-message vec 6 "%s" (string-join (process-command p) " ")) commit 6b7c22e7ee87a57ff78e2baf0baa847e34b9b4da Author: Mattias Engdegård Date: Mon Jul 26 09:15:04 2021 +0200 ; * lisp/replace.el (occur-after-change-function): Fix logic mistake diff --git a/lisp/replace.el b/lisp/replace.el index f8c5fed557..d0c6366915 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1407,9 +1407,9 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (common-prefix (lambda (s1 s2) (let ((c (compare-strings s1 nil nil s2 nil nil))) - (if (zerop c) - (length s1) - (1- (abs c)))))) + (if (numberp c) + (1- (abs c)) + (length s1))))) (prefix-len (funcall common-prefix buf-str text)) (suffix-len (funcall common-prefix (reverse buf-str) (reverse text)))) commit a45aed9479f610bcbc7a171b60d915fefc9b586a Author: Mattias Engdegård Date: Sun Jul 25 21:39:39 2021 +0200 Describe changes to the occur-mode implementation in NEWS * etc/NEWS: Mention change to the `occur-target` property (bug#39121). diff --git a/etc/NEWS b/etc/NEWS index 0d1abfd852..b969590f7c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -766,6 +766,15 @@ faces in other ways. *** The new command 'recenter-current-error', bound to 'l' in Occur or compilation buffers, recenters the current displayed occurrence/error. +--- +*** Occur mode may use a different type for 'occur-target' property values. +The value was previously always a marker set to the start of the first +match on the line but can now also be a list of (BEGIN . END) pairs +of markers delimiting each match on the line. +This is a fully compatible change to the internal occur-mode +implementation, and code creating their own occur-mode buffers will +work as before. + ** EIEIO +++ commit 81da37b66224e689bc38cdb17c1919235152f9fe Author: Glenn Morris Date: Sun Jul 25 09:44:37 2021 -0700 Fix recent gdb-mi change * lisp/progmodes/gdb-mi.el (gdb-registers-filter-pattern-list): Fix type. diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 38dd0a7702..57c99abec6 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -594,7 +594,7 @@ filter." Each pattern is a regular expression. GDB displays registers whose name matches any pattern in the list. Refresh the register buffer for the change to take effect." - :type 'list + :type '(repeat regexp) :group 'gdb-buffers :version "28.1") commit ed1480b1d9b6fc0265197d9c1f2976296fa91129 Merge: df7bb79f38 d0625dc553 Author: Glenn Morris Date: Sun Jul 25 07:57:23 2021 -0700 Merge from origin/emacs-27 d0625dc553 (origin/emacs-27) ; One more change in back.texi. 06d0a66e57 ; Yet another last-minute change in Emacs manual for printing commit df7bb79f3862e64739147fc1fc3c3e9af268d046 Author: Michael Albinus Date: Sun Jul 25 16:54:00 2021 +0200 Add instructions for Tramp bug reports * doc/misc/tramp.texi (Bug Reports): Describe how to use password cache with "emacs -Q". diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 088352e8a8..17302ddbf2 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4255,7 +4255,16 @@ test, @ref{Cleanup remote connections}. Alternatively, and often better for analysis, reproduce the problem in a clean Emacs session started with @command{emacs -Q}. Then, @value{tramp} does not load the persistency file (@pxref{Connection caching}), and it does not use -passwords from @file{auth-source.el} (@pxref{Password handling}). +passwords from @file{auth-source.el} (@pxref{Password handling}). If +you really need a password cache, for example for the +@option{sudoedit} method, call + +@smallexample +emacs -Q -l tramp \ + --eval '(setq tramp-cache-read-persistent-data t)' \ + --eval '(tramp-cleanup-all-connections)' +@end smallexample + When including @value{tramp}'s messages in the bug report, increase the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the commit f4d04931b7a2f32dd24bd45307cf4efb050793af Author: Mattias Engdegård Date: Sun Jul 25 13:04:43 2021 +0200 Fix tex-validate-buffer * lisp/textmodes/tex-mode.el (tex-validate-buffer): Set `inhibit-read-only` around all modifications of the read-protected *Occur* buffer (bug#19326). Add the `occur-match` property, and adjust the extent of the `occur-target` property, so that next-error and previous-error work correctly (bug#39121). diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index ababd775d5..d9d8059f96 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1426,20 +1426,22 @@ on the line for the invalidity you want to see." ;; Skip "Mismatches:" header line. (forward-line 1) (setq num-matches (1+ num-matches)) - (insert-buffer-substring buffer start end) - (let ((text-end (point-marker)) - (inhibit-read-only t) - text-beg) - (forward-char (- start end)) - (setq text-beg (point-marker)) - (insert (format "%3d: " linenum)) - (add-text-properties - text-beg (- text-end 1) - '(mouse-face highlight - help-echo - "mouse-2: go to this invalidity")) - (put-text-property text-beg (- text-end 1) - 'occur-target tem)))))))) + (let ((inhibit-read-only t)) + (insert-buffer-substring buffer start end) + (let ((text-end (point-marker)) + text-beg) + (forward-char (- start end)) + (setq text-beg (point-marker)) + (insert (format "%3d: " linenum)) + (add-text-properties + text-beg (- text-end 1) + '(mouse-face highlight + help-echo + "mouse-2: go to this invalidity")) + (put-text-property (point) (- text-end 1) + 'occur-match t) + (put-text-property text-beg text-end + 'occur-target tem))))))))) (with-current-buffer standard-output (let ((no-matches (zerop num-matches)) (inhibit-read-only t)) commit 697341d7fd80091a4243a813e2aecc07fd49b10c Author: Mattias Engdegård Date: Sun Jul 25 15:55:50 2021 +0200 Add back occur-mode-find-occurrence for compatibility (bug#39121) * lisp/replace.el (occur-mode-find-occurrence): Put back (an emulation of) the previously removed function. It is used internally in eshell and in some external code. Problem found by Basil Contovounesios. diff --git a/lisp/replace.el b/lisp/replace.el index 09bdf28dbc..f8c5fed557 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1426,6 +1426,11 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." "Handle `revert-buffer' for Occur mode buffers." (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) +;; Retained for compatibility. +(defun occur-mode-find-occurrence () + "Return a marker to the first match of the line at point." + (occur--targets-start (occur-mode--find-occurrences))) + (defun occur-mode--find-occurrences () ;; The `occur-target' property value is a list of (BEG . END) for each ;; match on the line, or (for compatibility) a single marker to the start commit 41a55a330f518254da795719ac6e3085254d4110 Author: Eli Zaretskii Date: Sun Jul 25 15:50:46 2021 +0300 Fix compilation of xftfont.c with old fontconfig * src/xftfont.c (FC_LCD_FILTER): Define if undefined, for older versions of fontconfig. This was mistakenly deleted 2 years ago. (Bug#49722) diff --git a/src/xftfont.c b/src/xftfont.c index f734931636..d8ad403548 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -33,6 +33,12 @@ along with GNU Emacs. If not, see . */ #include "ftfont.h" #include "pdumper.h" +#ifndef FC_LCD_FILTER +/* Older fontconfig versions don't have FC_LCD_FILTER. */ +# define FC_LCD_FILTER "lcdfilter" +#endif + + /* Xft font driver. */ /* Structure pointed by (struct face *)->extra */ commit 41e62df73af373f30a89281b25be0344b14cf98b Author: Michael Albinus Date: Sun Jul 25 14:14:49 2021 +0200 Fix extended attributes for Tramp's sudoedit method (bug#49724) * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file): Remove compat code for `{set-}file-extended-attributes'. (tramp-sudoedit-handle-write-region): Handle extended attributes. (Bug#49724) * test/lisp/net/tramp-tests.el (tramp-test25-file-selinux): Fix test for sudoedit method. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a6569e0cdd..7cf90b9661 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1946,7 +1946,7 @@ file names." (length (tramp-compat-file-attribute-size (file-attributes (file-truename filename)))) (attributes (and preserve-extended-attributes - (apply #'file-extended-attributes (list filename)))) + (file-extended-attributes filename))) (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil @@ -2022,7 +2022,7 @@ file names." ;; errors, because ACL strings could be incompatible. (when attributes (ignore-errors - (apply #'set-file-extended-attributes (list newname attributes)))) + (set-file-extended-attributes newname attributes))) ;; In case of `rename', we must flush the cache of the source file. (when (and t1 (eq op 'rename)) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 177dde67cc..e4d90dde70 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -237,7 +237,7 @@ absolute file names." (file-attributes filename))) (file-modes (tramp-default-file-modes filename)) (attributes (and preserve-extended-attributes - (apply #'file-extended-attributes (list filename)))) + (file-extended-attributes filename))) (sudoedit-operation (cond ((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p")) @@ -293,7 +293,7 @@ absolute file names." ;; errors, because ACL strings could be incompatible. (when attributes (ignore-errors - (apply #'set-file-extended-attributes (list newname attributes)))) + (set-file-extended-attributes newname attributes))) (when (and t1 (eq op 'rename)) (with-parsed-tramp-file-name filename v1 @@ -726,13 +726,14 @@ ID-FORMAT valid values are `string' and `integer'." (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer))) (flag (and (eq mustbenew 'excl) 'nofollow)) - (modes (tramp-default-file-modes filename flag))) + (modes (tramp-default-file-modes filename flag)) + (attributes (file-extended-attributes filename))) (prog1 (tramp-handle-write-region start end filename append visit lockname mustbenew) - ;; Set the ownership and modes. This is not performed in - ;; `tramp-handle-write-region'. + ;; Set the ownership, modes and extended attributes. This is + ;; not performed in `tramp-handle-write-region'. (unless (and (= (tramp-compat-file-attribute-user-id (file-attributes filename 'integer)) uid) @@ -740,7 +741,12 @@ ID-FORMAT valid values are `string' and `integer'." (file-attributes filename 'integer)) gid)) (tramp-set-file-uid-gid filename uid gid)) - (tramp-compat-set-file-modes filename modes flag))))) + (tramp-compat-set-file-modes filename modes flag) + ;; We ignore possible errors, because ACL strings could be + ;; incompatible. + (when attributes + (ignore-errors + (set-file-extended-attributes filename attributes))))))) ;; Internal functions. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index b3a00215ac..052c03029f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4096,7 +4096,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (file-selinux-context tmp-name1)) - (copy-file tmp-name1 tmp-name2) + (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions) (should (file-selinux-context tmp-name2)) (should (equal commit cb28b2e32bcd694e1684b5390a709057ffab5820 Author: Kévin Le Gouguec Date: Sun Jul 25 12:23:28 2021 +0200 * etc/NEWS: Fix renaming of directory-append. diff --git a/etc/NEWS b/etc/NEWS index f1635ae2e6..0d1abfd852 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3109,8 +3109,8 @@ The former is now declared obsolete. * Lisp Changes in Emacs 28.1 +++ -*** New function 'directory-append'. -This appends a file name to a directory name and returns the result. +*** New function 'file-name-concat'. +This appends path components to a directory name and returns the result. +++ *** New function 'split-string-shell-command'. commit 142961bcdfb202ca3347a085e55c87b164bb2fb9 Author: Christopher League Date: Sun Jul 25 09:37:36 2021 +0200 When bookmark is overwritten, unfontify its previous position * lisp/bookmark.el (bookmark-store): When the bookmark-fontify option is non-nil, setting or jumping to bookmarks will colorize them using `bookmark-face'. With this change, overwriting a bookmark will remove the fontification at its former position (bug#49725). diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 52b96fd203..ff9b8ab138 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -561,10 +561,14 @@ old one." (set-text-properties 0 (length stripped-name) nil stripped-name) (if (and (not no-overwrite) (bookmark-get-bookmark stripped-name 'noerror)) - ;; already existing bookmark under that name and - ;; no prefix arg means just overwrite old bookmark - ;; Use the new (NAME . ALIST) format. - (setcdr (bookmark-get-bookmark stripped-name) alist) + ;; Already existing bookmark under that name and + ;; no prefix arg means just overwrite old bookmark. + (let ((bm (bookmark-get-bookmark stripped-name))) + ;; First clean up if previously location was fontified. + (when bookmark-fontify + (bookmark--unfontify bm)) + ;; Modify using the new (NAME . ALIST) format. + (setcdr bm alist)) ;; otherwise just cons it onto the front (either the bookmark ;; doesn't exist already, or there is no prefix arg. In either commit 0577bd0cf9aca220c0ecba217ac9a9522ffa990d Author: Michael Albinus Date: Sun Jul 25 12:05:01 2021 +0200 Use `file-name-concat' in Tramp * lisp/net/tramp-compat.el (tramp-compat-file-name-concat): New defalias. * lisp/net/tramp.el (tramp-handle-expand-file-name): * lisp/net/tramp-adb.el (tramp-adb-handle-directory-files-and-attributes): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name): * lisp/net/tramp-sh.el (tramp-sh-handle-expand-file-name): * lisp/net/tramp-smb.el (tramp-smb-handle-expand-file-name): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-expand-file-name): Use it. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index b081e5957a..5e0accc142 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -327,9 +327,9 @@ arguments to pass to the OPERATION." v (format "%s -d -a -l %s %s" (tramp-adb-get-ls-command v) (tramp-shell-quote-argument - (concat (file-name-as-directory localname) ".")) + (tramp-compat-file-name-concat localname ".")) (tramp-shell-quote-argument - (concat (file-name-as-directory localname) "..")))) + (tramp-compat-file-name-concat localname "..")))) (widen))) (tramp-adb-sh-fix-ls-output) (let ((result (tramp-do-parse-file-attributes-with-ls diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9d5e5f787b..6e46407337 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -363,6 +363,20 @@ A nil value for either argument stands for the current time." ".#" (file-name-nondirectory filename)) (file-name-directory filename))))) +;; Function `file-name-concat' is new in Emacs 28.1. +(defalias 'tramp-compat-file-name-concat + (if (fboundp 'file-name-concat) + #'file-name-concat + (lambda (directory &rest components) + (unless (null directory) + (let ((components (delq nil components)) + file-name-handler-alist) + (if (null components) + directory + (tramp-compat-file-name-concat + (concat (file-name-as-directory directory) (car components)) + (cdr components)))))))) + (dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) (put (intern elt) 'tramp-suppress-trace t)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 022fdeeb88..db561b4fd0 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1142,7 +1142,7 @@ file names." (when (zerop (length name)) (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) + (setq name (tramp-compat-file-name-concat dir name))) ;; If NAME is not a Tramp file, run the real handler. (if (not (tramp-tramp-file-p name)) (tramp-run-real-handler #'expand-file-name (list name nil)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 41ab1045c2..a6569e0cdd 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2681,7 +2681,7 @@ the result will be a local, non-Tramp, file name." (tramp-run-real-handler #'expand-file-name (list name dir)) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) + (setq name (tramp-compat-file-name-concat dir name))) ;; If connection is not established yet, run the real handler. (if (not (tramp-connectable-p name)) (tramp-run-real-handler #'expand-file-name (list name nil)) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4e4f5548e2..3d5be61d3f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -722,7 +722,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when (zerop (length name)) (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) + (setq name (tramp-compat-file-name-concat dir name))) ;; If NAME is not a Tramp file, run the real handler. (if (not (tramp-tramp-file-p name)) (tramp-run-real-handler #'expand-file-name (list name nil)) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 45d9fab986..177dde67cc 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -353,7 +353,7 @@ the result will be a local, non-Tramp, file name." (when (zerop (length name)) (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) + (setq name (tramp-compat-file-name-concat dir name))) (with-parsed-tramp-file-name name nil ;; Tilde expansion if necessary. We cannot accept "~/", because ;; under sudo "~/" is expanded to the local user home directory diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 59c4f33f5e..4db0b2e672 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3346,7 +3346,7 @@ User is always nil." (when (zerop (length name)) (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) + (setq name (tramp-compat-file-name-concat dir name))) ;; If NAME is not a Tramp file, run the real handler. (if (not (tramp-tramp-file-p name)) (tramp-run-real-handler #'expand-file-name (list name nil)) commit b0d33d42535cc6aef2c518eba373332de59f210f Author: Mattias Engdegård Date: Sun Jul 25 11:24:53 2021 +0200 Don't squash markers in occur-edit-mode * lisp/replace.el (occur-after-change-function): Instead of replacing the whole line being edited, use shrink-wrapping to replace the smallest interval encompassing the change. That way, we avoid disturbing markers (such as occur highlighting locations) in the line; they would otherwise all be forced to the beginning. diff --git a/lisp/replace.el b/lisp/replace.el index 24befed241..09bdf28dbc 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1398,8 +1398,27 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (recenter line) (if readonly (message "Buffer `%s' is read only." buf) - (delete-region (line-beginning-position) (line-end-position)) - (insert text)) + ;; Replace the line, but make the change as small as + ;; possible by shrink-wrapping. That way, we avoid + ;; disturbing markers unnecessarily. + (let* ((beg-pos (line-beginning-position)) + (end-pos (line-end-position)) + (buf-str (buffer-substring-no-properties beg-pos end-pos)) + (common-prefix + (lambda (s1 s2) + (let ((c (compare-strings s1 nil nil s2 nil nil))) + (if (zerop c) + (length s1) + (1- (abs c)))))) + (prefix-len (funcall common-prefix buf-str text)) + (suffix-len (funcall common-prefix + (reverse buf-str) (reverse text)))) + (setq beg-pos (+ beg-pos prefix-len)) + (setq end-pos (- end-pos suffix-len)) + (setq text (substring text prefix-len (- suffix-len))) + (delete-region beg-pos end-pos) + (goto-char beg-pos) + (insert text))) (move-to-column col))))))) commit c52e26df30d5679dc2b9b34853a3c2db062524ac Author: Mattias Engdegård Date: Sat Jul 24 16:32:11 2021 +0200 Keep track of match extents in occur-mode (bug#39121) Use the `occur-target` text property to keep track of the extents of all matches on each line instead of just the start of the first match. Doing so allows us to highlight all matches when jumping to a matching line instead of just the first one, and it works in a more principled way. It also removes compatibility problems that were introduced with occur-highlight-regexp. For compatibility with code that populate their own occur-mode buffers, we still accept `occur-target` properties with a single marker as value. * lisp/replace.el (occur-highlight-regexp, occur-highlight-overlay): Remove. (occur-highlight-overlays): New. (occur--targets-start): New. * lisp/replace.el (occur-after-change-function): (occur-mode-find-occurrence): Replace with... (occur-mode--find-occurrences): ...this function that returns the whole `occur-target` property value. (occur-mode-goto-occurrence, occur-mode-goto-occurrence-other-window) (occur-goto-locus-delete-o, occur-mode-display-occurrence) (occur-engine): Adjust to new property format. (occur--highlight-occurrence): Replace with... (occur--highlight-occurrences): ...this function that takes the `occur-target` property value as argument. (occur-1): Don't use `occur-highlight-regexp`. * test/lisp/replace-tests.el (occur-highlight-occurrence): Adapt to new property format. diff --git a/lisp/replace.el b/lisp/replace.el index 7e30f1fc55..24befed241 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -792,12 +792,8 @@ which will run faster and will not set the mark or print anything." Maximum length of the history list is determined by the value of `history-length', which see.") -(defvar occur-highlight-regexp t - "Regexp matching part of visited source lines to highlight temporarily. -Highlight entire line if t; don't highlight source lines if nil.") - -(defvar occur-highlight-overlay nil - "Overlay used to temporarily highlight occur matches.") +(defvar occur-highlight-overlays nil + "Overlays used to temporarily highlight occur matches.") (defvar occur-collect-regexp-history '("\\1") "History of regexp for occur's collect operation") @@ -1357,18 +1353,27 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (occur-mode) (message "Switching to Occur mode."))) +(defun occur--targets-start (targets) + "First marker of the `occur-target' property value TARGETS." + (if (consp targets) + (caar targets) + ;; Tolerate an `occur-target' value that is a single marker for + ;; compatibility. + targets)) + (defun occur-after-change-function (beg end length) (save-excursion (goto-char beg) (let* ((line-beg (line-beginning-position)) - (m (get-text-property line-beg 'occur-target)) + (targets (get-text-property line-beg 'occur-target)) + (m (occur--targets-start targets)) (buf (marker-buffer m)) col) (when (and (get-text-property line-beg 'occur-prefix) (not (get-text-property end 'occur-prefix))) (when (= length 0) ;; Apply occur-target property to inserted (e.g. yanked) text. - (put-text-property beg end 'occur-target m) + (put-text-property beg end 'occur-target targets) ;; Did we insert a newline? Occur Edit mode can't create new ;; Occur entries; just discard everything after the newline. (save-excursion @@ -1402,35 +1407,38 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." "Handle `revert-buffer' for Occur mode buffers." (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) -(defun occur-mode-find-occurrence () - (let ((pos (get-text-property (point) 'occur-target))) - (unless pos +(defun occur-mode--find-occurrences () + ;; The `occur-target' property value is a list of (BEG . END) for each + ;; match on the line, or (for compatibility) a single marker to the start + ;; of the first match. + (let* ((targets (get-text-property (point) 'occur-target)) + (start (occur--targets-start targets))) + (unless targets (error "No occurrence on this line")) - (unless (buffer-live-p (marker-buffer pos)) + (unless (buffer-live-p (marker-buffer start)) (error "Buffer for this occurrence was killed")) - pos)) + targets)) (defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence) (defun occur-mode-goto-occurrence (&optional event) "Go to the occurrence specified by EVENT, a mouse click. If not invoked by a mouse click, go to occurrence on the current line." (interactive (list last-nonmenu-event)) - (let ((buffer (when event (current-buffer))) - (pos - (if (null event) - ;; Actually `event-end' works correctly with a nil argument as - ;; well, so we could dispense with this test, but let's not - ;; rely on this undocumented behavior. - (occur-mode-find-occurrence) - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion - (goto-char (posn-point (event-end event))) - (occur-mode-find-occurrence))))) - (regexp occur-highlight-regexp)) + (let* ((buffer (when event (current-buffer))) + (targets + (if (null event) + ;; Actually `event-end' works correctly with a nil argument as + ;; well, so we could dispense with this test, but let's not + ;; rely on this undocumented behavior. + (occur-mode--find-occurrences) + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (occur-mode--find-occurrences))))) + (pos (occur--targets-start targets))) (pop-to-buffer (marker-buffer pos)) (goto-char pos) - (let ((end-mk (save-excursion (re-search-forward regexp nil t)))) - (occur--highlight-occurrence pos end-mk)) + (occur--highlight-occurrences targets) (when buffer (next-error-found buffer (current-buffer))) (run-hooks 'occur-mode-find-occurrence-hook))) @@ -1438,15 +1446,15 @@ If not invoked by a mouse click, go to occurrence on the current line." "Go to the occurrence the current line describes, in another window." (interactive) (let ((buffer (current-buffer)) - (pos (occur-mode-find-occurrence))) + (pos (occur--targets-start (occur-mode--find-occurrences)))) (switch-to-buffer-other-window (marker-buffer pos)) (goto-char pos) (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook))) -;; Stolen from compile.el (defun occur-goto-locus-delete-o () - (delete-overlay occur-highlight-overlay) + (mapc #'delete-overlay occur-highlight-overlays) + (setq occur-highlight-overlays nil) ;; Get rid of timer and hook that would try to do this again. (if (timerp next-error-highlight-timer) (cancel-timer next-error-highlight-timer)) @@ -1454,64 +1462,55 @@ If not invoked by a mouse click, go to occurrence on the current line." #'occur-goto-locus-delete-o)) ;; Highlight the current visited occurrence. -;; Adapted from `compilation-goto-locus'. -(defun occur--highlight-occurrence (mk end-mk) - (let ((highlight-regexp occur-highlight-regexp)) - (if (timerp next-error-highlight-timer) - (cancel-timer next-error-highlight-timer)) - (unless occur-highlight-overlay - (setq occur-highlight-overlay - (make-overlay (point-min) (point-min))) - (overlay-put occur-highlight-overlay 'face 'next-error)) - (with-current-buffer (marker-buffer mk) - (save-excursion - (if end-mk (goto-char end-mk) (end-of-line)) - (let ((end (point))) - (if mk (goto-char mk) (beginning-of-line)) - (if (and (stringp highlight-regexp) - (re-search-forward highlight-regexp end t)) - (progn - (goto-char (match-beginning 0)) - (move-overlay occur-highlight-overlay - (match-beginning 0) (match-end 0) - (current-buffer))) - (move-overlay occur-highlight-overlay - (point) end (current-buffer))) - (if (or (eq next-error-highlight t) - (numberp next-error-highlight)) - ;; We want highlighting: delete overlay on next input. - (add-hook 'pre-command-hook - #'occur-goto-locus-delete-o) - ;; We don't want highlighting: delete overlay now. - (delete-overlay occur-highlight-overlay)) - ;; We want highlighting for a limited time: - ;; set up a timer to delete it. - (when (numberp next-error-highlight) - (setq next-error-highlight-timer - (run-at-time next-error-highlight nil - 'occur-goto-locus-delete-o)))))) - (when (eq next-error-highlight 'fringe-arrow) - ;; We want a fringe arrow (instead of highlighting). - (setq next-error-overlay-arrow-position - (copy-marker (line-beginning-position)))))) +(defun occur--highlight-occurrences (targets) + (let ((start-marker (occur--targets-start targets))) + (occur-goto-locus-delete-o) + (with-current-buffer (marker-buffer start-marker) + (when (or (eq next-error-highlight t) + (numberp next-error-highlight)) + (setq occur-highlight-overlays + (mapcar (lambda (target) + (let ((o (make-overlay (car target) (cdr target)))) + (overlay-put o 'face 'next-error) + o)) + (if (listp targets) + targets + ;; `occur-target' compatibility: when we only + ;; have a single starting point, highlight the + ;; rest of the line. + (let ((end-pos (save-excursion + (goto-char start-marker) + (line-end-position)))) + (list (cons start-marker end-pos)))))) + (add-hook 'pre-command-hook #'occur-goto-locus-delete-o) + (when (numberp next-error-highlight) + ;; We want highlighting for a limited time: + ;; set up a timer to delete it. + (setq next-error-highlight-timer + (run-at-time next-error-highlight nil + 'occur-goto-locus-delete-o)))) + + (when (eq next-error-highlight 'fringe-arrow) + ;; We want a fringe arrow (instead of highlighting). + (setq next-error-overlay-arrow-position + (copy-marker (line-beginning-position))))))) (defun occur-mode-display-occurrence () "Display in another window the occurrence the current line describes." (interactive) - (let ((buffer (current-buffer)) - (pos (occur-mode-find-occurrence)) - (regexp occur-highlight-regexp) - (next-error-highlight next-error-highlight-no-select) - (display-buffer-overriding-action - '(nil (inhibit-same-window . t))) - window) + (let* ((buffer (current-buffer)) + (targets (occur-mode--find-occurrences)) + (pos (occur--targets-start targets)) + (next-error-highlight next-error-highlight-no-select) + (display-buffer-overriding-action + '(nil (inhibit-same-window . t))) + window) (setq window (display-buffer (marker-buffer pos) t)) ;; This is the way to set point in the proper window. (save-selected-window (select-window window) (goto-char pos) - (let ((end-mk (save-excursion (re-search-forward regexp nil t)))) - (occur--highlight-occurrence pos end-mk)) + (occur--highlight-occurrences targets) (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook)))) @@ -1868,7 +1867,6 @@ See also `multi-occur'." (buffer-undo-list t) (occur--final-pos nil)) (erase-buffer) - (setq-local occur-highlight-regexp regexp) (let ((count (if (stringp nlines) ;; Treat nlines as a regexp to collect. @@ -1968,7 +1966,7 @@ See also `multi-occur'." (origpt nil) (begpt nil) (endpt nil) - (marker nil) + markers ; list of (BEG-MARKER . END-MARKER) (curstring "") (ret nil) ;; The following binding is for when case-fold-search @@ -1994,8 +1992,7 @@ See also `multi-occur'." (setq endpt (line-end-position))) ;; Sum line numbers up to the first match line. (setq curr-line (+ curr-line (count-lines origpt begpt))) - (setq marker (make-marker)) - (set-marker marker matchbeg) + (setq markers nil) (setq curstring (occur-engine-line begpt endpt keep-props)) ;; Highlight the matches (let ((len (length curstring)) @@ -2017,6 +2014,11 @@ See also `multi-occur'." (setq orig-line-shown-p t))) (while (and (< start len) (string-match regexp curstring start)) + (push (cons (set-marker (make-marker) + (+ begpt (match-beginning 0))) + (set-marker (make-marker) + (+ begpt (match-end 0)))) + markers) (setq matches (1+ matches)) (add-text-properties (match-beginning 0) (match-end 0) @@ -2029,6 +2031,7 @@ See also `multi-occur'." ;; Avoid infloop (Bug#7593). (let ((end (match-end 0))) (setq start (if (= start end) (1+ start) end))))) + (setq markers (nreverse markers)) ;; Generate the string to insert for this match (let* ((match-prefix ;; Using 7 digits aligns tabs properly. @@ -2042,7 +2045,7 @@ See also `multi-occur'." ;; (for Occur Edit mode). front-sticky t rear-nonsticky t - occur-target ,marker + occur-target ,markers follow-link t help-echo "mouse-2: go to this occurrence")))) (match-str @@ -2050,7 +2053,7 @@ See also `multi-occur'." ;; because that loses. And don't put it ;; on context lines to reduce flicker. (propertize curstring - 'occur-target marker + 'occur-target markers 'follow-link t 'help-echo "mouse-2: go to this occurrence")) @@ -2069,8 +2072,8 @@ See also `multi-occur'." ;; get a contiguous highlight. (propertize (concat match-prefix match-str) 'mouse-face 'highlight)) - ;; Add marker at eol, but no mouse props. - (propertize "\n" 'occur-target marker))) + ;; Add markers at eol, but no mouse props. + (propertize "\n" 'occur-target markers))) (data (if (= nlines 0) ;; The simple display style diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 417946c35f..7f62a417a0 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -589,7 +589,7 @@ bound to HIGHLIGHT-LOCUS." (replace-tests-with-highlighted-occurrence highlight-locus (occur-mode-display-occurrence) (with-current-buffer (marker-buffer - (get-text-property (point) 'occur-target)) + (caar (get-text-property (point) 'occur-target))) (should (funcall check-overlays has-overlay))))))) (ert-deftest replace-regexp-bug45973 () commit d3415724a686107236f78d745700221a397ffb4f Author: Arthur Miller Date: Sat Jul 24 16:58:08 2021 +0200 Support '--group-directories-first' in ls-lisp.el * lisp/ls-lisp.el (ls-lisp--sanitize-switches): New function. (ls-lisp--insert-directory): Support '--group-directories-first'. Call 'ls-lisp--sanitize-switches' to convert long options to short forms and remove unsupported long options. Update the doc string. Copyright-paperwork-exempt: yes diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 24d49ea6d8..9041b9ac0f 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -276,7 +276,9 @@ supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' is non-nil; otherwise, it interprets wildcards as regular expressions to match file names. It does not support all `ls' switches -- those that work are: A a B C c F G g h i n R r S s t U u v X. The l switch -is assumed to be always present and cannot be turned off." +is assumed to be always present and cannot be turned off. +Long variants of the above switches, as documented for GNU `ls', +are also supported; unsupported long options are silently ignored." (if ls-lisp-use-insert-directory-program (funcall orig-fun file switches wildcard full-directory-p) @@ -284,13 +286,21 @@ is assumed to be always present and cannot be turned off." (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory)) (orig-file file) - wildcard-regexp) + wildcard-regexp + (ls-lisp-dirs-first + (or ls-lisp-dirs-first + (string-match "--group-directories-first" switches)))) (if handler (funcall handler 'insert-directory file switches wildcard full-directory-p) - ;; Remove --dired switch - (if (string-match "--dired " switches) - (setq switches (replace-match "" nil nil switches))) + (when (string-match "--group-directories-first" switches) + ;; if ls-lisp-dirs-first is nil, dirs are grouped but come out in + ;; reverse order: + (setq ls-lisp-dirs-first t) + (setq switches (replace-match "" nil nil switches))) + ;; Remove unrecognized long options, and convert the + ;; recognized ones to their short variants. + (setq switches (ls-lisp--sanitize-switches switches)) ;; Convert SWITCHES to a list of characters. (setq switches (delete ?\ (delete ?- (append switches nil)))) ;; Sometimes we get ".../foo*/" as FILE. While the shell and @@ -890,6 +900,60 @@ All ls time options, namely c, t and u, are handled." ;; Continue standard unloading. nil) +(defun ls-lisp--sanitize-switches (switches) + "Convert long options of GNU 'ls' to their short form. +Conversion is done only for flags supported by ls-lisp. +Long options not supported by ls-lisp are removed. +Supported options are: A a B C c F G g h i n R r S s t U u v X. +The l switch is assumed to be always present and cannot be turned off." + (let ((lsflags '(("-a" . "--all") + ("-A" . "--almost-all") + ("-B" . "--ignore-backups") + ("-C" . "--color") + ("-F" . "--classify") + ("-G" . "--no-group") + ("-h" . "--human-readable") + ("-H" . "--dereference-command-line") + ("-i" . "--inode") + ("-n" . "--numeric-uid-gid") + ("-r" . "--reverse") + ("-R" . "--recursive") + ("-s" . "--size") + ("-S" . "--sort.*[ \\\t]") + ("" . "--group-directories-first") + ("" . "--author") + ("" . "--escape") + ("" . "--directory") + ("" . "--dired") + ("" . "--file-type") + ("" . "--format") + ("" . "--full-time") + ("" . "--si") + ("" . "--dereference-command-line-symlink-to-dir") + ("" . "--hide") + ("" . "--hyperlink") + ("" . "--ignore") + ("" . "--kibibytes") + ("" . "--dereference") + ("" . "--literal") + ("" . "--hide-control-chars") + ("" . "--show-control-chars") + ("" . "--quote-name") + ("" . "--context") + ("" . "--help") + ;; ("" . "--indicator-style.*[ \\\t]") + ;; ("" . "--quoting-style.*[ \t\\]") + ;; ("" . "--time.*[ \\\t]") + ;; ("" . "--time-style.*[ \\\t]") + ;; ("" . "--tabsize.*[ \\\t]") + ;; ("" . "--width.*[ \\\t]") + ("" . "--.*=.*[ \\\t\n]?") ;; catch all with '=' sign in + ("" . "--version")))) + (dolist (f lsflags) + (if (string-match (cdr f) switches) + (setq switches (replace-match (car f) nil nil switches)))) + (string-trim switches))) + (provide 'ls-lisp) ;;; ls-lisp.el ends here commit a6afa221d7b373271bedef69e3a5f9e957e9fbf8 Author: Peter Feigl Date: Sun Jul 25 09:16:08 2021 +0200 Add commands to move to next/previous column in tabulated-list-mode * lisp/emacs-lisp/tabulated-list.el (tabulated-list-mode-map): Add keybindings M-left and M-right. (tabulated-list-previous-column tabulated-list-next-column): Implement commands (bug#44711). diff --git a/etc/NEWS b/etc/NEWS index f1502a8e0e..f1635ae2e6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2331,6 +2331,9 @@ previously no easy way to get back to the original displayed order after sorting, but giving a -1 numerical prefix to the sorting command will now restore the original order. +--- +*** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'. + +++ *** New utility function 'insert-into-buffer'. This is like 'insert-buffer-substring', but works in the opposite diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 04f3b70aaa..f0ee78745a 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -214,6 +214,8 @@ If ADVANCE is non-nil, move forward by one line afterwards." special-mode-map)) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) + (define-key map (kbd "M-") 'tabulated-list-previous-column) + (define-key map (kbd "M-") 'tabulated-list-next-column) (define-key map "S" 'tabulated-list-sort) (define-key map "}" 'tabulated-list-widen-current-column) (define-key map "{" 'tabulated-list-narrow-current-column) @@ -740,6 +742,28 @@ Interactively, N is the prefix numeric argument, and defaults to (setq-local tabulated-list--current-lnum-width lnum-width) (tabulated-list-init-header))))) +(defun tabulated-list-next-column (&optional arg) + "Go to the start of the next column after point on the current line. +If ARG is provided, move that many columns." + (interactive "p") + (dotimes (_ (or arg 1)) + (let ((next (or (next-single-property-change + (point) 'tabulated-list-column-name) + (point-max)))) + (when (<= next (line-end-position)) + (goto-char next))))) + +(defun tabulated-list-previous-column (&optional arg) + "Go to the start of the column point is in on the current line. +If ARG is provided, move that many columns." + (interactive "p") + (dotimes (_ (or arg 1)) + (let ((prev (or (previous-single-property-change + (point) 'tabulated-list-column-name) + 1))) + (unless (< prev (line-beginning-position)) + (goto-char prev))))) + ;;; The mode definition: (defvar tabulated-list--original-order nil) commit f04f8126f016b43c45d432bf353ba2a0ac8f7d96 Author: Lars Ingebrigtsen Date: Sun Jul 25 08:54:20 2021 +0200 Rename directory-append to file-name-concat * src/fileio.c (Ffile_name_concat): * lisp/files.el (move-file-to-trash): * lisp/emacs-lisp/shortdoc.el (file-name): * doc/lispref/files.texi (Directory Names): Rename `directory-append' to `file-name-concat'. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index e7a0ad2d06..266501d46d 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2343,14 +2343,14 @@ entirely of directory separators. @end example @end defun -@defun directory-append directory &rest components +@defun file-name-concat directory &rest components Concatenate @var{components} to @var{directory}, inserting a slash before the components if @var{directory} or the preceding component didn't end with a slash. @example @group -(directory-append "/tmp" "foo") +(file-name-concat "/tmp" "foo") @result{} "/tmp/foo" @end group @end example diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index c507ad7c81..a74a5a4225 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -273,11 +273,11 @@ There can be any number of :example/:result elements." :eval (file-relative-name "/tmp/foo" "/tmp")) (make-temp-name :eval (make-temp-name "/tmp/foo-")) - (directory-append - :eval (directory-append "/tmp/" "foo") - :eval (directory-append "/tmp" "foo") - :eval (directory-append "/tmp" "foo" "bar/" "zot") - :eval (directory-append "/tmp" "~")) + (file-name-concat + :eval (file-name-concat "/tmp/" "foo") + :eval (file-name-concat "/tmp" "foo") + :eval (file-name-concat "/tmp" "foo" "bar/" "zot") + :eval (file-name-concat "/tmp" "~")) (expand-file-name :eval (expand-file-name "foo" "/tmp/") :eval (expand-file-name "foo" "/tmp///") diff --git a/lisp/files.el b/lisp/files.el index 78b76592bd..6088822686 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8127,14 +8127,14 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; exists, but the file name may exist in the trash ;; directory even if there is no info file for it. (when (file-exists-p - (directory-append trash-files-dir files-base)) + (file-name-concat trash-files-dir files-base)) (setq overwrite t files-base (file-name-nondirectory (make-temp-file - (directory-append + (file-name-concat trash-files-dir files-base) is-directory)))) - (setq info-fn (directory-append + (setq info-fn (file-name-concat trash-info-dir (concat files-base ".trashinfo"))) ;; Re-check the existence (sort of). @@ -8145,14 +8145,14 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; like Emacs-style backup file names. E.g.: ;; https://bugs.kde.org/170956 (setq info-fn (make-temp-file - (directory-append trash-info-dir files-base) + (file-name-concat trash-info-dir files-base) nil ".trashinfo")) (setq files-base (substring (file-name-nondirectory info-fn) 0 (- (length ".trashinfo")))) (write-region nil nil info-fn nil 'quiet info-fn))) ;; Finally, try to move the file to the trashcan. (let ((delete-by-moving-to-trash nil) - (new-fn (directory-append trash-files-dir files-base))) + (new-fn (file-name-concat trash-files-dir files-base))) (rename-file fn new-fn overwrite))))))))) (defsubst file-attribute-type (attributes) diff --git a/src/fileio.c b/src/fileio.c index 3d8b082a59..13c99bee10 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -749,7 +749,7 @@ For that reason, you should normally use `make-temp-file' instead. */) empty_unibyte_string, Qnil); } -DEFUN ("directory-append", Fdirectory_append, Sdirectory_append, 1, MANY, 0, +DEFUN ("file-name-concat", Ffile_name_concat, Sfile_name_concat, 1, MANY, 0, doc: /* Append COMPONENTS to DIRECTORY and return the resulting string. Elements in COMPONENTS must be a string or nil. DIRECTORY or the non-final elements in COMPONENTS may or may not end @@ -6596,7 +6596,7 @@ This includes interactive calls to `delete-file' and defsubr (&Sdirectory_file_name); defsubr (&Smake_temp_file_internal); defsubr (&Smake_temp_name); - defsubr (&Sdirectory_append); + defsubr (&Sfile_name_concat); defsubr (&Sexpand_file_name); defsubr (&Ssubstitute_in_file_name); defsubr (&Scopy_file); diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index b1288f943e..f4d123b426 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -160,26 +160,26 @@ Also check that an encoding error can appear in a symlink." (should-error (file-exists-p "/foo\0bar") :type 'wrong-type-argument)) -(ert-deftest fileio-tests/directory-append () - (should (equal (directory-append "foo" "bar") "foo/bar")) - (should (equal (directory-append "foo" "bar") "foo/bar")) - (should (equal (directory-append "foo" "bar" "zot") "foo/bar/zot")) - (should (equal (directory-append "foo/" "bar") "foo/bar")) - (should (equal (directory-append "foo//" "bar") "foo//bar")) - (should (equal (directory-append "foo/" "bar/" "zot") "foo/bar/zot")) - (should (equal (directory-append "fóo" "bar") "fóo/bar")) - (should (equal (directory-append "foo" "bár") "foo/bár")) - (should (equal (directory-append "fóo" "bár") "fóo/bár")) +(ert-deftest fileio-tests/file-name-concat () + (should (equal (file-name-concat "foo" "bar") "foo/bar")) + (should (equal (file-name-concat "foo" "bar") "foo/bar")) + (should (equal (file-name-concat "foo" "bar" "zot") "foo/bar/zot")) + (should (equal (file-name-concat "foo/" "bar") "foo/bar")) + (should (equal (file-name-concat "foo//" "bar") "foo//bar")) + (should (equal (file-name-concat "foo/" "bar/" "zot") "foo/bar/zot")) + (should (equal (file-name-concat "fóo" "bar") "fóo/bar")) + (should (equal (file-name-concat "foo" "bár") "foo/bár")) + (should (equal (file-name-concat "fóo" "bár") "fóo/bár")) (let ((string (make-string 5 ?a))) (should (not (multibyte-string-p string))) (aset string 2 255) (should (not (multibyte-string-p string))) - (should (equal (directory-append "fóo" string) "fóo/aa\377aa"))) - (should (equal (directory-append "foo") "foo")) - (should (equal (directory-append "foo/") "foo/")) - (should (equal (directory-append "foo" "") "foo")) - (should (equal (directory-append "foo" "" "" "" nil) "foo")) - (should (equal (directory-append "" "bar") "bar")) - (should (equal (directory-append "" "") ""))) + (should (equal (file-name-concat "fóo" string) "fóo/aa\377aa"))) + (should (equal (file-name-concat "foo") "foo")) + (should (equal (file-name-concat "foo/") "foo/")) + (should (equal (file-name-concat "foo" "") "foo")) + (should (equal (file-name-concat "foo" "" "" "" nil) "foo")) + (should (equal (file-name-concat "" "bar") "bar")) + (should (equal (file-name-concat "" "") ""))) ;;; fileio-tests.el ends here commit aa9cba658768aba4da1b74ffb33d9962ffff5756 Author: Lars Ingebrigtsen Date: Sun Jul 25 08:00:50 2021 +0200 Allow empty elements in directory-append * doc/lispref/files.texi (Directory Names): Document it. * src/fileio.c (Fdirectory_append): Allow empty elements. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 804cef292e..e7a0ad2d06 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2355,7 +2355,9 @@ didn't end with a slash. @end group @end example -A zero-length directory or component is not allowed. +A @var{directory} or components that are @code{nil} or the empty +string are ignored---they are filtered out first and do not affect the +results in any way. This is almost the same as using @code{concat}, but @var{dirname} (and the non-final components) may or may not end with slash characters, diff --git a/src/fileio.c b/src/fileio.c index d6b3e7bca4..3d8b082a59 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -751,14 +751,14 @@ For that reason, you should normally use `make-temp-file' instead. */) DEFUN ("directory-append", Fdirectory_append, Sdirectory_append, 1, MANY, 0, doc: /* Append COMPONENTS to DIRECTORY and return the resulting string. -COMPONENTS must be strings. +Elements in COMPONENTS must be a string or nil. DIRECTORY or the non-final elements in COMPONENTS may or may not end with a slash -- if they don't end with a slash, a slash will be inserted before contatenating. usage: (record DIRECTORY &rest COMPONENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t chars = 0, bytes = 0, multibytes = 0; + ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0; Lisp_Object *elements = args; Lisp_Object result; ptrdiff_t i; @@ -768,9 +768,13 @@ usage: (record DIRECTORY &rest COMPONENTS) */) for (i = 0; i < nargs; i++) { Lisp_Object arg = args[i]; + /* Skip empty and nil elements. */ + if (NILP (arg)) + continue; CHECK_STRING (arg); if (SCHARS (arg) == 0) - xsignal1 (Qfile_error, build_string ("Empty file name")); + continue; + eargs++; /* Multibyte and non-ASCII. */ if (STRING_MULTIBYTE (arg) && SCHARS (arg) != SBYTES (arg)) multibytes++; @@ -789,25 +793,41 @@ usage: (record DIRECTORY &rest COMPONENTS) */) } /* Convert if needed. */ - if (multibytes != 0 && multibytes != nargs) + if ((multibytes != 0 && multibytes != nargs) + || eargs != nargs) { - elements = xmalloc (nargs * sizeof *elements); + int j = 0; + elements = xmalloc (eargs * sizeof *elements); bytes = 0; + chars = 0; + + /* Filter out nil/"". */ for (i = 0; i < nargs; i++) { Lisp_Object arg = args[i]; + if (!NILP (arg) && SCHARS (arg) != 0) + elements[j++] = arg; + } + + for (i = 0; i < eargs; i++) + { + Lisp_Object arg = elements[i]; /* Use multibyte or all-ASCII strings as is. */ - if (STRING_MULTIBYTE (arg) || string_ascii_p (arg)) - elements[i] = arg; - else + if (!STRING_MULTIBYTE (arg) && !string_ascii_p (arg)) elements[i] = Fstring_to_multibyte (arg); arg = elements[i]; /* We have to recompute the number of bytes. */ - if (i == nargs - 1 + if (i == eargs - 1 || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1))) - bytes += SBYTES (arg); + { + bytes += SBYTES (arg); + chars += SCHARS (arg); + } else - bytes += SBYTES (arg) + 1; + { + bytes += SBYTES (arg) + 1; + chars += SCHARS (arg) + 1; + } } } @@ -821,13 +841,13 @@ usage: (record DIRECTORY &rest COMPONENTS) */) /* Copy over the data. */ char *p = SSDATA (result); - for (i = 0; i < nargs; i++) + for (i = 0; i < eargs; i++) { Lisp_Object arg = elements[i]; memcpy (p, SSDATA (arg), SBYTES (arg)); p += SBYTES (arg); /* The last element shouldn't have a slash added at the end. */ - if (i < nargs - 1 && !IS_DIRECTORY_SEP (*(p - 1))) + if (i < eargs - 1 && !IS_DIRECTORY_SEP (*(p - 1))) *p++ = DIRECTORY_SEP; } diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 73a7775279..b1288f943e 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -175,8 +175,11 @@ Also check that an encoding error can appear in a symlink." (aset string 2 255) (should (not (multibyte-string-p string))) (should (equal (directory-append "fóo" string) "fóo/aa\377aa"))) - (should-error (directory-append "foo" "")) - (should-error (directory-append "" "bar")) - (should-error (directory-append "" ""))) + (should (equal (directory-append "foo") "foo")) + (should (equal (directory-append "foo/") "foo/")) + (should (equal (directory-append "foo" "") "foo")) + (should (equal (directory-append "foo" "" "" "" nil) "foo")) + (should (equal (directory-append "" "bar") "bar")) + (should (equal (directory-append "" "") ""))) ;;; fileio-tests.el ends here commit 03f844249cb15a8380d09041a537803c933a2769 Author: Mattias Engdegård Date: Sat Jul 24 17:11:21 2021 +0200 Disable delay and ding in replace-tests * test/lisp/replace-tests.el (replace-tests-with-undo): When testing the "U" (undo all changes) option, the code will delay and ding which is obnoxious in an automated test. Disabling that makes the test quiet and about 150 times faster. diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 6d004e657d..417946c35f 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -465,7 +465,12 @@ Return the last evalled form in BODY." ;; isearch-lazy-highlight-new-loop and sit-for (bug#36328) ((symbol-function 'replace-highlight) (lambda (&rest _args) - (string-match "[A-Z ]" "ForestGreen")))) + (string-match "[A-Z ]" "ForestGreen"))) + ;; Override `sit-for' and `ding' so that we don't have + ;; to wait and listen to bells when running the test. + ((symbol-function 'sit-for) + (lambda (&rest _args) (redisplay))) + ((symbol-function 'ding) 'ignore)) (perform-replace ,from ,to t replace-tests-perform-replace-regexp-flag nil)) ,@body)))) commit e3155440dc36e02b3704ca7f9e4cf8728a2e2131 Author: Eli Zaretskii Date: Sat Jul 24 20:18:28 2021 +0300 ; * src/fileio.c (Fdirectory_append): Doc fix. diff --git a/src/fileio.c b/src/fileio.c index 6d505fd0f0..d6b3e7bca4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -751,9 +751,10 @@ For that reason, you should normally use `make-temp-file' instead. */) DEFUN ("directory-append", Fdirectory_append, Sdirectory_append, 1, MANY, 0, doc: /* Append COMPONENTS to DIRECTORY and return the resulting string. -COMPONENTS must be a list of strings. DIRECTORY or the non-final -elements in COMPONENTS may or may not end with a slash -- if they don't -end with a slash, a slash will be inserted before contatenating. +COMPONENTS must be strings. +DIRECTORY or the non-final elements in COMPONENTS may or may not end +with a slash -- if they don't end with a slash, a slash will be +inserted before contatenating. usage: (record DIRECTORY &rest COMPONENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { commit 7c83e605ab84e8b62254c55f347abc8aa9c6057b Author: Yuan Fu Date: Sat Jul 24 19:11:08 2021 +0200 Add filter to GDB's register buffer * lisp/progmodes/gdb-mi.el (gdb-registers-enable-filter) (gdb-registers-filter-pattern-list): New custom options. (gdb-header-click-event-handler, gdb-registers-toggle-filter): New functions. (gdb-header-click-event-handler): Only add a register if it passes the filter. (gdb-registers-mode-map): New keybinding for toggling the filter. (gdb-registers-header): New buttons on the header line for the filter (bug#39179). diff --git a/etc/NEWS b/etc/NEWS index bb5e6aee78..f1502a8e0e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1601,6 +1601,10 @@ See the new user options 'package-name-column-width', ** gdb-mi +*** New user option 'gdb-registers-enable-filter'. +If non-nil, apply a register filter based on +'gdb-registers-filter-pattern-list'. + +++ *** gdb-mi can now store and restore window configurations. Use 'gdb-save-window-configuration' to save window configuration to a diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index aa3365278c..38dd0a7702 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -581,6 +581,23 @@ stopped thread is already selected." :group 'gdb-buffers :version "23.2") +(defcustom gdb-registers-enable-filter nil + "If non-nil, enable register name filter in register buffer. +Use `gdb-registers-filter-pattern-list' to control what register to +filter." + :type 'boolean + :group 'gdb-buffers + :version "28.1") + +(defcustom gdb-registers-filter-pattern-list nil + "Patterns for names that are displayed in register buffer. +Each pattern is a regular expression. GDB displays registers +whose name matches any pattern in the list. Refresh the register +buffer for the change to take effect." + :type 'list + :group 'gdb-buffers + :version "28.1") + (defvar gdb-debug-log nil "List of commands sent to and replies received from GDB. Most recent commands are listed first. This list stores only the last @@ -4393,6 +4410,26 @@ member." 'gdb-registers-mode 'gdb-invalidate-registers) +(defun gdb-header-click-event-handler (function) + "Return a function that handles clicking event on gdb header buttons. + +This function switches to the window where the header locates and +executes FUNCTION." + (lambda (event) + (interactive "e") + (save-selected-window + ;; Make sure we are in the right buffer. + (select-window (posn-window (event-start event))) + (funcall function)))) + +(defun gdb-registers-toggle-filter () + "Toggle register filter." + (interactive) + (setq gdb-registers-enable-filter + (not gdb-registers-enable-filter)) + ;; Update the register buffer. + (gdb-invalidate-registers 'update)) + (defun gdb-registers-handler-custom () (when gdb-register-names (let ((register-values @@ -4403,17 +4440,27 @@ member." (value (gdb-mi--field register 'value)) (register-name (nth (string-to-number register-number) gdb-register-names))) - (gdb-table-add-row - table - (list - (propertize register-name - 'font-lock-face font-lock-variable-name-face) - (if (member register-number gdb-changed-registers) - (propertize value 'font-lock-face font-lock-warning-face) - value)) - `(mouse-face highlight - help-echo "mouse-2: edit value" - gdb-register-name ,register-name)))) + ;; Add register if `gdb-registers-filter-pattern-list' is nil; + ;; or any pattern that `gdb-registers-filter-pattern-list' + ;; matches. + (when (or (null gdb-registers-enable-filter) + ;; Return t if any register name matches a pattern. + (cl-loop for pattern + in gdb-registers-filter-pattern-list + if (string-match pattern register-name) + return t + finally return nil)) + (gdb-table-add-row + table + (list + (propertize register-name + 'font-lock-face font-lock-variable-name-face) + (if (member register-number gdb-changed-registers) + (propertize value 'font-lock-face font-lock-warning-face) + value)) + `(mouse-face highlight + help-echo "mouse-2: edit value" + gdb-register-name ,register-name))))) (insert (gdb-table-string table " "))) (setq mode-name (gdb-current-context-mode-name "Registers")))) @@ -4441,6 +4488,7 @@ member." (gdb-get-buffer-create 'gdb-locals-buffer gdb-thread-number) t))) + (define-key map "f" #'gdb-registers-toggle-filter) map)) (defvar gdb-registers-header @@ -4450,7 +4498,31 @@ member." mode-line-inactive) " " (gdb-propertize-header "Registers" gdb-registers-buffer - nil nil mode-line))) + nil nil mode-line) + " " + '(:eval + (format + "[filter %s %s]" + (propertize + (if gdb-registers-enable-filter "[on]" "[off]") + 'face (if gdb-registers-enable-filter + '(:weight bold :inherit success) + 'shadow) + 'help-echo "mouse-1: toggle filter" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 (gdb-header-click-event-handler + #'gdb-registers-toggle-filter))) + (propertize + "[set]" + 'face 'mode-line + 'help-echo "mouse-1: Customize filter patterns" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 (lambda () + (interactive) + (customize-variable-other-window + 'gdb-registers-filter-pattern-list)))))))) (define-derived-mode gdb-registers-mode gdb-parent-mode "Registers" "Major mode for gdb registers." commit 42d4537ed2cae41c969f59b413b4b9adae6dbc9b Author: Lars Ingebrigtsen Date: Sat Jul 24 18:48:44 2021 +0200 Really convert to multibyte in Fdirectory_append * src/fileio.c (Fdirectory_append): Fix check for whether we need to convert to multibyte. (Fdirectory_append): diff --git a/src/fileio.c b/src/fileio.c index 60f5650302..6d505fd0f0 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -799,8 +799,7 @@ usage: (record DIRECTORY &rest COMPONENTS) */) if (STRING_MULTIBYTE (arg) || string_ascii_p (arg)) elements[i] = arg; else - elements[i] = make_multibyte_string (SSDATA (arg), SCHARS (arg), - SCHARS (arg)); + elements[i] = Fstring_to_multibyte (arg); arg = elements[i]; /* We have to recompute the number of bytes. */ if (i == nargs - 1 diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 702659fa39..73a7775279 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -170,6 +170,11 @@ Also check that an encoding error can appear in a symlink." (should (equal (directory-append "fóo" "bar") "fóo/bar")) (should (equal (directory-append "foo" "bár") "foo/bár")) (should (equal (directory-append "fóo" "bár") "fóo/bár")) + (let ((string (make-string 5 ?a))) + (should (not (multibyte-string-p string))) + (aset string 2 255) + (should (not (multibyte-string-p string))) + (should (equal (directory-append "fóo" string) "fóo/aa\377aa"))) (should-error (directory-append "foo" "")) (should-error (directory-append "" "bar")) (should-error (directory-append "" ""))) commit 0c77d1d2ca9a20d4b77a1228ee8f6e9aac64063a Author: Michael Albinus Date: Sat Jul 24 18:49:57 2021 +0200 Fix last commit in tramp.el diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 24953f751e..59c4f33f5e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -701,7 +701,7 @@ The regexp should match at end of buffer." ;; Yubikey requires the user physically to touch the device with their ;; finger. We must tell it to the user. (defcustom tramp-yubikey-regexp - (regexp-quote "Confirm user presence for key .*") + "Confirm user presence for key .*" "Regular expression matching yubikey confirmation message. The regexp should match at end of buffer." :version "28.1" commit 4b1367ee97446ed29b76aa49782e675918d5ca35 Author: Lars Ingebrigtsen Date: Sat Jul 24 18:35:14 2021 +0200 Fix Fdirectory_append check for whether strings have to be converted * src/coding.c (string_ascii_p): Make it non-static. * src/fileio.c (Fdirectory_append): Fix check for whether we need to convert to multibyte. * src/fns.c (string_ascii_p): Remove copy. * src/lisp.h: Declare string_ascii_p. diff --git a/src/coding.c b/src/coding.c index 46e7fca0f4..87b55aecc0 100644 --- a/src/coding.c +++ b/src/coding.c @@ -9476,7 +9476,7 @@ not fully specified.) */) } /* Whether STRING only contains chars in the 0..127 range. */ -static bool +bool string_ascii_p (Lisp_Object string) { ptrdiff_t nbytes = SBYTES (string); diff --git a/src/fileio.c b/src/fileio.c index 643fc36168..60f5650302 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -796,7 +796,7 @@ usage: (record DIRECTORY &rest COMPONENTS) */) { Lisp_Object arg = args[i]; /* Use multibyte or all-ASCII strings as is. */ - if (STRING_MULTIBYTE (arg) || SCHARS (arg) == SBYTES (arg)) + if (STRING_MULTIBYTE (arg) || string_ascii_p (arg)) elements[i] = arg; else elements[i] = make_multibyte_string (SSDATA (arg), SCHARS (arg), diff --git a/src/fns.c b/src/fns.c index 7b9e3b0f7f..932800a3a4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5769,16 +5769,6 @@ characters. */ ) return list3 (make_int (lines), make_int (longest), make_float (mean)); } -static bool -string_ascii_p (Lisp_Object string) -{ - ptrdiff_t nbytes = SBYTES (string); - for (ptrdiff_t i = 0; i < nbytes; i++) - if (SREF (string, i) > 127) - return false; - return true; -} - DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0, doc: /* Search for the string NEEDLE in the string HAYSTACK. The return value is the position of the first occurrence of NEEDLE in diff --git a/src/lisp.h b/src/lisp.h index 80efd77113..15a42a4456 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3586,6 +3586,7 @@ extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t, extern void init_coding (void); extern void init_coding_once (void); extern void syms_of_coding (void); +extern bool string_ascii_p (Lisp_Object); /* Defined in character.c. */ extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t); commit 26da0b5ecb44ba5a8954be98b97ab59ccb391531 Author: Lars Ingebrigtsen Date: Sat Jul 24 18:21:50 2021 +0200 Set the normal-erase-is-backspace variable from Customize * lisp/simple.el (normal-erase-is-backspace): Always set the variable so that Customize is up-to-date (bug#49593). diff --git a/lisp/simple.el b/lisp/simple.el index 1a49fe2425..5ec7fd80eb 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9535,9 +9535,9 @@ call `normal-erase-is-backspace-mode' (which see) instead." :set (lambda (symbol value) ;; The fboundp is because of a problem with :set when ;; dumping Emacs. It doesn't really matter. - (if (fboundp 'normal-erase-is-backspace-mode) - (normal-erase-is-backspace-mode (or value 0)) - (set-default symbol value)))) + (when (fboundp 'normal-erase-is-backspace-mode) + (normal-erase-is-backspace-mode (or value 0))) + (set-default symbol value))) (defun normal-erase-is-backspace-setup-frame (&optional frame) "Set up `normal-erase-is-backspace-mode' on FRAME, if necessary." commit 6becc97433cc7caeae462df56c5ed5660fefe232 Author: Lars Ingebrigtsen Date: Sat Jul 24 18:09:14 2021 +0200 Tweak Fdirectory_append slightly * src/fileio.c (Fdirectory_append): Make the xfree condition more robust. diff --git a/src/fileio.c b/src/fileio.c index ddce4723f4..643fc36168 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -827,11 +827,11 @@ usage: (record DIRECTORY &rest COMPONENTS) */) memcpy (p, SSDATA (arg), SBYTES (arg)); p += SBYTES (arg); /* The last element shouldn't have a slash added at the end. */ - if (i < nargs -1 && !IS_DIRECTORY_SEP (*(p - 1))) + if (i < nargs - 1 && !IS_DIRECTORY_SEP (*(p - 1))) *p++ = DIRECTORY_SEP; } - if (multibytes != 0 && multibytes != nargs) + if (elements != args) xfree (elements); return result; commit ba918ecb7891c6d0bb7bbaab93b4316881166d94 Author: Lars Ingebrigtsen Date: Sat Jul 24 18:06:36 2021 +0200 Improve directory-append manual entry * doc/lispref/files.texi (Directory Names): Mention zero-length restriction. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index a624c2eb93..804cef292e 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2355,6 +2355,8 @@ didn't end with a slash. @end group @end example +A zero-length directory or component is not allowed. + This is almost the same as using @code{concat}, but @var{dirname} (and the non-final components) may or may not end with slash characters, and this function will not double those characters. commit 28bf38743db6656715c5f3221d52467cbac4872f Author: Lars Ingebrigtsen Date: Sat Jul 24 17:28:10 2021 +0200 Tweak Fdirectory_append for efficiency * src/fileio.c (Fdirectory_append): Make slightly more efficient. diff --git a/src/fileio.c b/src/fileio.c index a4f0838377..ddce4723f4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -795,7 +795,8 @@ usage: (record DIRECTORY &rest COMPONENTS) */) for (i = 0; i < nargs; i++) { Lisp_Object arg = args[i]; - if (STRING_MULTIBYTE (arg)) + /* Use multibyte or all-ASCII strings as is. */ + if (STRING_MULTIBYTE (arg) || SCHARS (arg) == SBYTES (arg)) elements[i] = arg; else elements[i] = make_multibyte_string (SSDATA (arg), SCHARS (arg), commit b4543dfa9e72deeee607ffa9396a680c51a00968 Author: Lars Ingebrigtsen Date: Sat Jul 24 17:22:43 2021 +0200 Extend directory-append to take an arbitrary number of components * doc/lispref/files.texi (Directory Names): Document it. * lisp/emacs-lisp/shortdoc.el (file-name): Add new example. * src/fileio.c (Fdirectory_append): Change the function to take an arbitrary number of components. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index ec8a2525ed..a624c2eb93 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2343,9 +2343,10 @@ entirely of directory separators. @end example @end defun -@defun directory-append directory filename -Combine @var{filename} with @var{directory} by optionally putting a -slash in the middle. +@defun directory-append directory &rest components +Concatenate @var{components} to @var{directory}, inserting a slash +before the components if @var{directory} or the preceding component +didn't end with a slash. @example @group @@ -2354,9 +2355,9 @@ slash in the middle. @end group @end example -This is almost the same as using @code{concat}, but @var{dirname} may -or may not end with a slash character, and this function will not -double that character. +This is almost the same as using @code{concat}, but @var{dirname} (and +the non-final components) may or may not end with slash characters, +and this function will not double those characters. @end defun To convert a directory name to its abbreviation, use this diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 7506d756d1..c507ad7c81 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -276,6 +276,7 @@ There can be any number of :example/:result elements." (directory-append :eval (directory-append "/tmp/" "foo") :eval (directory-append "/tmp" "foo") + :eval (directory-append "/tmp" "foo" "bar/" "zot") :eval (directory-append "/tmp" "~")) (expand-file-name :eval (expand-file-name "foo" "/tmp/") diff --git a/src/fileio.c b/src/fileio.c index 277da48315..a4f0838377 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -749,48 +749,90 @@ For that reason, you should normally use `make-temp-file' instead. */) empty_unibyte_string, Qnil); } -DEFUN ("directory-append", Fdirectory_append, Sdirectory_append, 2, 2, 0, - doc: /* Return FILE (a string) appended to DIRECTORY (a string). -DIRECTORY may or may not end with a slash -- the return value from -this function will be the same. */) - (Lisp_Object directory, Lisp_Object file) +DEFUN ("directory-append", Fdirectory_append, Sdirectory_append, 1, MANY, 0, + doc: /* Append COMPONENTS to DIRECTORY and return the resulting string. +COMPONENTS must be a list of strings. DIRECTORY or the non-final +elements in COMPONENTS may or may not end with a slash -- if they don't +end with a slash, a slash will be inserted before contatenating. +usage: (record DIRECTORY &rest COMPONENTS) */) + (ptrdiff_t nargs, Lisp_Object *args) { - USE_SAFE_ALLOCA; - char *p; - - CHECK_STRING (file); - CHECK_STRING (directory); + ptrdiff_t chars = 0, bytes = 0, multibytes = 0; + Lisp_Object *elements = args; + Lisp_Object result; + ptrdiff_t i; + + /* First go through the list to check the types and see whether + they're all of the same multibytedness. */ + for (i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + CHECK_STRING (arg); + if (SCHARS (arg) == 0) + xsignal1 (Qfile_error, build_string ("Empty file name")); + /* Multibyte and non-ASCII. */ + if (STRING_MULTIBYTE (arg) && SCHARS (arg) != SBYTES (arg)) + multibytes++; + /* We're not adding a slash to the final part. */ + if (i == nargs - 1 + || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1))) + { + bytes += SBYTES (arg); + chars += SCHARS (arg); + } + else + { + bytes += SBYTES (arg) + 1; + chars += SCHARS (arg) + 1; + } + } - if (SCHARS (file) == 0) - xsignal1 (Qfile_error, build_string ("Empty file name")); + /* Convert if needed. */ + if (multibytes != 0 && multibytes != nargs) + { + elements = xmalloc (nargs * sizeof *elements); + bytes = 0; + for (i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + if (STRING_MULTIBYTE (arg)) + elements[i] = arg; + else + elements[i] = make_multibyte_string (SSDATA (arg), SCHARS (arg), + SCHARS (arg)); + arg = elements[i]; + /* We have to recompute the number of bytes. */ + if (i == nargs - 1 + || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1))) + bytes += SBYTES (arg); + else + bytes += SBYTES (arg) + 1; + } + } - if (SCHARS (directory) == 0) - return file; + /* Allocate an empty string. */ + if (multibytes == 0) + result = make_uninit_string (chars); + else + result = make_uninit_multibyte_string (chars, bytes); + /* Null-terminate the string. */ + *(SSDATA (result) + SBYTES (result)) = 0; - /* Make the strings the same multibytedness. */ - if (STRING_MULTIBYTE (file) != STRING_MULTIBYTE (directory)) + /* Copy over the data. */ + char *p = SSDATA (result); + for (i = 0; i < nargs; i++) { - if (STRING_MULTIBYTE (file)) - directory = make_multibyte_string (SSDATA (directory), - SCHARS (directory), - SCHARS (directory)); - else - file = make_multibyte_string (SSDATA (file), - SCHARS (file), - SCHARS (file)); - } - - /* Allocate enough extra space in case we need to put a slash in - there. */ - p = SAFE_ALLOCA (SBYTES (file) + SBYTES (directory) + 2); - ptrdiff_t offset = SBYTES (directory); - memcpy (p, SSDATA (directory), offset); - if (! IS_DIRECTORY_SEP (p[offset - 1])) - p[offset++] = DIRECTORY_SEP; - memcpy (p + offset, SSDATA (file), SBYTES (file)); - p[offset + SBYTES (file)] = 0; - Lisp_Object result = build_string (p); - SAFE_FREE (); + Lisp_Object arg = elements[i]; + memcpy (p, SSDATA (arg), SBYTES (arg)); + p += SBYTES (arg); + /* The last element shouldn't have a slash added at the end. */ + if (i < nargs -1 && !IS_DIRECTORY_SEP (*(p - 1))) + *p++ = DIRECTORY_SEP; + } + + if (multibytes != 0 && multibytes != nargs) + xfree (elements); + return result; } diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 80afeae41b..702659fa39 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -162,10 +162,16 @@ Also check that an encoding error can appear in a symlink." (ert-deftest fileio-tests/directory-append () (should (equal (directory-append "foo" "bar") "foo/bar")) + (should (equal (directory-append "foo" "bar") "foo/bar")) + (should (equal (directory-append "foo" "bar" "zot") "foo/bar/zot")) (should (equal (directory-append "foo/" "bar") "foo/bar")) (should (equal (directory-append "foo//" "bar") "foo//bar")) + (should (equal (directory-append "foo/" "bar/" "zot") "foo/bar/zot")) + (should (equal (directory-append "fóo" "bar") "fóo/bar")) + (should (equal (directory-append "foo" "bár") "foo/bár")) + (should (equal (directory-append "fóo" "bár") "fóo/bár")) (should-error (directory-append "foo" "")) - (should (equal (directory-append "" "bar") "bar")) + (should-error (directory-append "" "bar")) (should-error (directory-append "" ""))) ;;; fileio-tests.el ends here commit 8cd66a3170b4117d3cbcdce7a09837e3c2ea0e43 Author: Basil L. Contovounesios Date: Sat Jul 24 14:59:36 2021 +0100 ; Fix directory-append arglist in files.texi. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index ac49c5aa74..ec8a2525ed 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2343,7 +2343,7 @@ entirely of directory separators. @end example @end defun -@defun directory-append filename directory +@defun directory-append directory filename Combine @var{filename} with @var{directory} by optionally putting a slash in the middle. commit 4d439744685b6b2492685124994120ebd1fa4abb Merge: 9ad1f71c39 8b808be2fb Author: Michael Albinus Date: Sat Jul 24 13:58:23 2021 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 9ad1f71c39eda81237df048cc170bee6e4216d97 Author: Michael Albinus Date: Sat Jul 24 13:58:03 2021 +0200 Add Tramp support for yubikey (bug#49714) * lisp/net/tramp.el (tramp-yubikey-regexp): New defcustom. (tramp-action-show-and-confirm-message): New defun. * lisp/net/tramp-sh.el (tramp-actions-before-shell) (tramp-actions-copy-out-of-band): Add `tramp-yubikey-regexp' action. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f94508303d..41ab1045c2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -519,6 +519,7 @@ shell from reading its init file." (tramp-yn-prompt-regexp tramp-action-yn) (tramp-terminal-prompt-regexp tramp-action-terminal) (tramp-antispoof-regexp tramp-action-confirm-message) + (tramp-yubikey-regexp tramp-action-show-and-confirm-message) (tramp-process-alive-regexp tramp-action-process-alive)) "List of pattern/action pairs. Whenever a pattern matches, the corresponding action is performed. @@ -536,6 +537,7 @@ corresponding PATTERN matches, the ACTION function is called.") '((tramp-password-prompt-regexp tramp-action-password) (tramp-wrong-passwd-regexp tramp-action-permission-denied) (tramp-copy-failed-regexp tramp-action-permission-denied) + (tramp-yubikey-regexp tramp-action-show-and-confirm-message) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 093335a77b..24953f751e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -698,6 +698,15 @@ The regexp should match at end of buffer." :version "27.1" :type 'regexp) +;; Yubikey requires the user physically to touch the device with their +;; finger. We must tell it to the user. +(defcustom tramp-yubikey-regexp + (regexp-quote "Confirm user presence for key .*") + "Regular expression matching yubikey confirmation message. +The regexp should match at end of buffer." + :version "28.1" + :type 'regexp) + (defcustom tramp-operation-not-permitted-regexp (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" (regexp-opt '("Operation not permitted") t)) @@ -4669,6 +4678,20 @@ The terminal type can be configured with `tramp-terminal-type'." (tramp-send-string vec tramp-local-end-of-line) t) +(defun tramp-action-show-and-confirm-message (_proc vec) + "Show the user a message for confirmation. +Wait, until the user has entered RET." + (save-window-excursion + (let ((enable-recursive-minibuffers t) + (stimers (with-timeout-suspend))) + (with-current-buffer (tramp-get-connection-buffer vec) + (tramp-message vec 6 "\n%s" (buffer-string)) + (pop-to-buffer (current-buffer))) + (read-string "Press ENTER to continue") + ;; Reenable the timers. + (with-timeout-unsuspend stimers))) + t) + (defun tramp-action-process-alive (proc _vec) "Check, whether a process has finished." (unless (process-live-p proc) commit 8b808be2fb9135b0ea1fe90c08869c345f77cfc5 Author: Lars Ingebrigtsen Date: Sat Jul 24 13:53:46 2021 +0200 Adjust tab-bar to the new mode-line-misc-info value * lisp/tab-bar.el (tab-bar--define-keys): Adjust to the new default value for `mode-line-misc-info'. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 41d565abd5..c63ef20abe 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -136,7 +136,7 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and ;; Replace default value with a condition that supports displaying ;; global-mode-string in the tab bar instead of the mode line. (when (and (memq 'tab-bar-format-global tab-bar-format) - (member '(global-mode-string ("" global-mode-string " ")) + (member '(global-mode-string ("" global-mode-string)) mode-line-misc-info)) (setf (alist-get 'global-mode-string mode-line-misc-info) '(("" (:eval (if (and tab-bar-mode commit d8a4a5ac7c3cbccf938febc4cafb521a1daa165a Author: Lars Ingebrigtsen Date: Sat Jul 24 13:47:54 2021 +0200 Remove duplicated NEWS entries diff --git a/etc/NEWS b/etc/NEWS index a10c580037..bb5e6aee78 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2512,25 +2512,6 @@ If non-nil (the default), revealed text is automatically hidden when point leaves the text. If nil, the text is not hidden again. Instead 'M-x reveal-hide-revealed' can be used to hide all the revealed text. -+++ -*** New user options to control the look of line/column numbers in the mode line. -'mode-line-position-line-format' is the line number format (when -'line-number-mode' is on), 'mode-line-position-column-format' is -the column number format (when 'column-number-mode' is on), and -'mode-line-position-column-line-format' is the combined format (when -both modes are on). - -+++ -*** New user option 'mode-line-compact'. -If non-nil, repeating spaces are compressed into a single space. If -'long', this is only done when the mode line is longer than the -current window width (in characters). - -+++ -*** 'global-mode-string' constructs should end with a space. -This was previously not formalized, which led to combinations of modes -displaying data "smushed together" on the mode line. - +++ *** New command 'submit-emacs-patch'. This works like 'report-emacs-bug', but is more geared towards sending commit 9192f5d25b26788d74b5ba2eb18f244e03669686 Author: Lars Ingebrigtsen Date: Sat Jul 24 13:46:02 2021 +0200 Make 's' in *Help* work for Lisp-defined variables again * lisp/help-fns.el (describe-variable): Make the `s' command work for Lisp-defined variables again (bug#39121). diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 7641774615..d7fb038f45 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1078,7 +1078,9 @@ it is displayed along with the global value." (with-current-buffer standard-output (setq help-mode--current-data (list :symbol variable - :type 'variable + :type (if (eq file-name 'C-source) + 'variable + 'defvar) :file file-name)) (save-excursion (re-search-backward (substitute-command-keys commit 86a795f6dd6c690d83eddd753a4972c555a1ac5f Author: Lars Ingebrigtsen Date: Sat Jul 24 13:34:52 2021 +0200 Fix problem when moving files called ~ to the trash * lisp/files.el (move-file-to-trash): Construct the trash file name safely (bug#49711). This makes (move-file-to-trash "/tmp/~") etc work. diff --git a/lisp/files.el b/lisp/files.el index aab839eab1..78b76592bd 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8127,16 +8127,16 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; exists, but the file name may exist in the trash ;; directory even if there is no info file for it. (when (file-exists-p - (expand-file-name files-base trash-files-dir)) + (directory-append trash-files-dir files-base)) (setq overwrite t files-base (file-name-nondirectory (make-temp-file - (expand-file-name - files-base trash-files-dir) + (directory-append + trash-files-dir files-base) is-directory)))) - (setq info-fn (expand-file-name - (concat files-base ".trashinfo") - trash-info-dir)) + (setq info-fn (directory-append + trash-info-dir + (concat files-base ".trashinfo"))) ;; Re-check the existence (sort of). (condition-case nil (write-region nil nil info-fn nil 'quiet info-fn 'excl) @@ -8145,14 +8145,14 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; like Emacs-style backup file names. E.g.: ;; https://bugs.kde.org/170956 (setq info-fn (make-temp-file - (expand-file-name files-base trash-info-dir) + (directory-append trash-info-dir files-base) nil ".trashinfo")) (setq files-base (substring (file-name-nondirectory info-fn) 0 (- (length ".trashinfo")))) (write-region nil nil info-fn nil 'quiet info-fn))) ;; Finally, try to move the file to the trashcan. (let ((delete-by-moving-to-trash nil) - (new-fn (expand-file-name files-base trash-files-dir))) + (new-fn (directory-append trash-files-dir files-base))) (rename-file fn new-fn overwrite))))))))) (defsubst file-attribute-type (attributes) commit 5431a58e86d3f2579c1edf1dc8d7074de73ac694 Author: Lars Ingebrigtsen Date: Sat Jul 24 13:30:58 2021 +0200 Add new function `directory-append' * doc/lispref/files.texi (Directory Names): Document it, and remove the concat-based file concatenation description. * lisp/emacs-lisp/shortdoc.el (file-name): Add. And add more expand-file-name examples. * src/fileio.c (Fdirectory_append): New function. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index c7e5537c10..ac49c5aa74 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2343,49 +2343,21 @@ entirely of directory separators. @end example @end defun - Given a directory name, you can combine it with a relative file name -using @code{concat}: +@defun directory-append filename directory +Combine @var{filename} with @var{directory} by optionally putting a +slash in the middle. @example -(concat @var{dirname} @var{relfile}) -@end example - -@noindent -Be sure to verify that the file name is relative before doing that. -If you use an absolute file name, the results could be syntactically -invalid or refer to the wrong file. - - If you want to use a directory file name in making such a -combination, you must first convert it to a directory name using -@code{file-name-as-directory}: - -@example -(concat (file-name-as-directory @var{dirfile}) @var{relfile}) -@end example - -@noindent -Don't try concatenating a slash by hand, as in - -@example -;;; @r{Wrong!} -(concat @var{dirfile} "/" @var{relfile}) -@end example - -@noindent -because this is not portable. Always use -@code{file-name-as-directory}. - - To avoid the issues mentioned above, or if the @var{dirname} value -might be @code{nil} (for example, from an element of @code{load-path}), -use: - -@example -(expand-file-name @var{relfile} @var{dirname}) +@group +(directory-append "/tmp" "foo") + @result{} "/tmp/foo" +@end group @end example -However, @code{expand-file-name} expands leading @samp{~} in -@var{relfile}, which may not be what you want. @xref{File Name -Expansion}. +This is almost the same as using @code{concat}, but @var{dirname} may +or may not end with a slash character, and this function will not +double that character. +@end defun To convert a directory name to its abbreviation, use this function: diff --git a/etc/NEWS b/etc/NEWS index e4b0809c5f..a10c580037 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3120,6 +3120,10 @@ The former is now declared obsolete. * Lisp Changes in Emacs 28.1 ++++ +*** New function 'directory-append'. +This appends a file name to a directory name and returns the result. + +++ *** New function 'split-string-shell-command'. This splits a shell command string into separate components, diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 22439f4c36..7506d756d1 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -273,8 +273,15 @@ There can be any number of :example/:result elements." :eval (file-relative-name "/tmp/foo" "/tmp")) (make-temp-name :eval (make-temp-name "/tmp/foo-")) + (directory-append + :eval (directory-append "/tmp/" "foo") + :eval (directory-append "/tmp" "foo") + :eval (directory-append "/tmp" "~")) (expand-file-name - :eval (expand-file-name "foo" "/tmp/")) + :eval (expand-file-name "foo" "/tmp/") + :eval (expand-file-name "foo" "/tmp///") + :eval (expand-file-name "foo" "/tmp/foo/.././") + :eval (expand-file-name "~" "/tmp/")) (substitute-in-file-name :eval (substitute-in-file-name "$HOME/foo")) "Directory Functions" diff --git a/src/fileio.c b/src/fileio.c index 04c9d7d4af..277da48315 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -749,6 +749,51 @@ For that reason, you should normally use `make-temp-file' instead. */) empty_unibyte_string, Qnil); } +DEFUN ("directory-append", Fdirectory_append, Sdirectory_append, 2, 2, 0, + doc: /* Return FILE (a string) appended to DIRECTORY (a string). +DIRECTORY may or may not end with a slash -- the return value from +this function will be the same. */) + (Lisp_Object directory, Lisp_Object file) +{ + USE_SAFE_ALLOCA; + char *p; + + CHECK_STRING (file); + CHECK_STRING (directory); + + if (SCHARS (file) == 0) + xsignal1 (Qfile_error, build_string ("Empty file name")); + + if (SCHARS (directory) == 0) + return file; + + /* Make the strings the same multibytedness. */ + if (STRING_MULTIBYTE (file) != STRING_MULTIBYTE (directory)) + { + if (STRING_MULTIBYTE (file)) + directory = make_multibyte_string (SSDATA (directory), + SCHARS (directory), + SCHARS (directory)); + else + file = make_multibyte_string (SSDATA (file), + SCHARS (file), + SCHARS (file)); + } + + /* Allocate enough extra space in case we need to put a slash in + there. */ + p = SAFE_ALLOCA (SBYTES (file) + SBYTES (directory) + 2); + ptrdiff_t offset = SBYTES (directory); + memcpy (p, SSDATA (directory), offset); + if (! IS_DIRECTORY_SEP (p[offset - 1])) + p[offset++] = DIRECTORY_SEP; + memcpy (p + offset, SSDATA (file), SBYTES (file)); + p[offset + SBYTES (file)] = 0; + Lisp_Object result = build_string (p); + SAFE_FREE (); + return result; +} + /* NAME must be a string. */ static bool file_name_absolute_no_tilde_p (Lisp_Object name) @@ -6488,6 +6533,7 @@ This includes interactive calls to `delete-file' and defsubr (&Sdirectory_file_name); defsubr (&Smake_temp_file_internal); defsubr (&Smake_temp_name); + defsubr (&Sdirectory_append); defsubr (&Sexpand_file_name); defsubr (&Ssubstitute_in_file_name); defsubr (&Scopy_file); diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index b989c97fe6..80afeae41b 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -160,4 +160,12 @@ Also check that an encoding error can appear in a symlink." (should-error (file-exists-p "/foo\0bar") :type 'wrong-type-argument)) +(ert-deftest fileio-tests/directory-append () + (should (equal (directory-append "foo" "bar") "foo/bar")) + (should (equal (directory-append "foo/" "bar") "foo/bar")) + (should (equal (directory-append "foo//" "bar") "foo//bar")) + (should-error (directory-append "foo" "")) + (should (equal (directory-append "" "bar") "bar")) + (should-error (directory-append "" ""))) + ;;; fileio-tests.el ends here commit d0625dc5530dbaec847c5973a0851b635c03e0fa (refs/remotes/origin/emacs-27) Author: Eli Zaretskii Date: Sat Jul 24 13:41:01 2021 +0300 ; One more change in back.texi. diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi index 343df709a8..dc4e218d37 100644 --- a/doc/emacs/back.texi +++ b/doc/emacs/back.texi @@ -93,7 +93,7 @@ Emacs in 1984/85. He has received the ACM Grace Hopper Award, a MacArthur Foundation fellowship, the Electronic Frontier Foundation's Pioneer award, the Takeda Award for Social/Economic Betterment, and the ACM Software and System Award, as well as several doctorates -honoris causa. +@emph{honoris causa.} @end quotation @hfil commit 06d0a66e57367923b50098395c6285933ee3a413 Author: Eli Zaretskii Date: Sat Jul 24 13:15:50 2021 +0300 ; Yet another last-minute change in Emacs manual for printing * doc/emacs/book-spine.texi: * doc/emacs/back.texi: Minor copyedits. diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi index ae0121e1a8..343df709a8 100644 --- a/doc/emacs/back.texi +++ b/doc/emacs/back.texi @@ -48,6 +48,7 @@ The ability to: Create @strong{PostScript output} from plain-text files (special editing modes for @LaTeX{} and @TeX{} are included). + @item @strong{Compile} and @strong{debug} from inside Emacs. @@ -67,7 +68,7 @@ Enjoy the use of extensive @strong{merge} and @strong{diff} functions. @item Take advantage of built-in support for many @strong{version control -systems}, including Git, Mercurial, Bazaar, Subversion, and CVS. +systems,} including Git, Mercurial, Bazaar, Subversion, and CVS. @item And much more! @@ -82,8 +83,8 @@ useful to expert users. It also includes appendices with specific material about X and GTK resources, and with details for users of macOS and Microsoft Windows. -And when you tire of all the work you can accomplish with it, Emacs -contains games to play. +And when you tire of all the work you can accomplish with Emacs, enjoy +the games that come with it. @strong{About the original and principal author:} @@ -97,3 +98,5 @@ honoris causa. @hfil @bye + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/doc/emacs/book-spine.texi b/doc/emacs/book-spine.texi index 20e23ca2bf..9634cceeda 100644 --- a/doc/emacs/book-spine.texi +++ b/doc/emacs/book-spine.texi @@ -13,7 +13,7 @@ @center @titlefont{GNU Emacs Manual} @sp 5 -@center @value{EDITION} edition, for Emacs Version @value{EMACSVER} +@center @value{EDITION} edition, for Emacs version @value{EMACSVER} @sp 5 @center by Richard M.@: Stallman et al. commit 9ac6ff53b105925400a773a5088c9d0ec5b095a4 Author: Lars Ingebrigtsen Date: Sat Jul 24 11:16:15 2021 +0200 Make the test for auto-mode-alist from .dir-local.el stricter * lisp/files.el (set-auto-mode--dir-local-valid-p): New function. (set-auto-mode--apply-alist): Use it as a stricter test. diff --git a/lisp/files.el b/lisp/files.el index d915c2a30b..aab839eab1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3238,14 +3238,21 @@ extra checks should be done." (setq mode (car mode) name (substring name 0 (match-beginning 0))) (setq name nil))) - (when (and dir-local mode) - (unless (string-suffix-p "-mode" (symbol-name mode)) - (message "Ignoring invalid mode `%s'" (symbol-name mode)) - (setq mode nil))) + (when (and dir-local mode + (not (set-auto-mode--dir-local-valid-p mode))) + (message "Ignoring invalid mode `%s'" mode) + (setq mode nil)) (when mode (set-auto-mode-0 mode keep-mode-if-same) t)))) +(defun set-auto-mode--dir-local-valid-p (mode) + "Say whether MODE can be used in a .dir-local.el `auto-mode-alist'." + (and (symbolp mode) + (string-suffix-p "-mode" (symbol-name mode)) + (commandp mode) + (not (provided-mode-derived-p mode 'special-mode)))) + (defun set-auto-mode (&optional keep-mode-if-same) "Select major mode appropriate for current buffer. diff --git a/test/lisp/files-resources/.dir-locals.el b/test/lisp/files-resources/.dir-locals.el index 84997b8a0c..84393aa54d 100644 --- a/test/lisp/files-resources/.dir-locals.el +++ b/test/lisp/files-resources/.dir-locals.el @@ -1,2 +1,5 @@ ;; This is used by files-tests.el. -((auto-mode-alist . (("\\.quux\\'" . tcl-mode)))) +((auto-mode-alist . (("\\.quux\\'" . tcl-mode) + ("\\.zot1\\'" . foobar) + ("\\.zot2\\'" . (lambda ())) + ("\\.zot3\\'" . dired-mode)))) diff --git a/test/lisp/files-resources/auto-test.zot1 b/test/lisp/files-resources/auto-test.zot1 new file mode 100644 index 0000000000..80acfcc9f7 --- /dev/null +++ b/test/lisp/files-resources/auto-test.zot1 @@ -0,0 +1 @@ +zot1 diff --git a/test/lisp/files-resources/auto-test.zot2 b/test/lisp/files-resources/auto-test.zot2 new file mode 100644 index 0000000000..975fc76551 --- /dev/null +++ b/test/lisp/files-resources/auto-test.zot2 @@ -0,0 +1 @@ +zot2 diff --git a/test/lisp/files-resources/auto-test.zot3 b/test/lisp/files-resources/auto-test.zot3 new file mode 100644 index 0000000000..faa0715160 --- /dev/null +++ b/test/lisp/files-resources/auto-test.zot3 @@ -0,0 +1 @@ +zot3 diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index fce7e3fd71..a5c8236017 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1537,7 +1537,13 @@ The door of all subtleties! (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" (find-file (ert-resource-file "whatever.quux")) - (should (eq major-mode 'tcl-mode))) + (should (eq major-mode 'tcl-mode)) + (find-file (ert-resource-file "auto-test.zot1")) + (should (eq major-mode 'fundamental-mode)) + (find-file (ert-resource-file "auto-test.zot2")) + (should (eq major-mode 'fundamental-mode)) + (find-file (ert-resource-file "auto-test.zot3")) + (should (eq major-mode 'fundamental-mode))) (provide 'files-tests) ;;; files-tests.el ends here commit 59eaa30c90cbd31c829dc383ceecaa7a75951e53 Author: Eli Zaretskii Date: Fri Jul 23 22:49:34 2021 +0300 ; * etc/NEWS: Fix wording of the 'fill-column' entry. diff --git a/etc/NEWS b/etc/NEWS index 37472b7f63..e4b0809c5f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -119,9 +119,8 @@ page for 'seccomp' system call, for details about Secure Computing filters. ** Setting 'fill-column' to nil is obsolete. -This undocumented use of 'fill-column' is now obsolete. If you have -set this value to nil disable auto filling, instead disable -'auto-fill-mode' in the relevant mode instead. +This undocumented use of 'fill-column' is now obsolete. To disable +auto filling, turn off 'auto-fill-mode' instead. For instance, you could add something like the following to your init file: commit 26ff27714ce753faf6a3aab773f71493949b7112 Author: Eli Zaretskii Date: Fri Jul 23 22:46:28 2021 +0300 ; * lisp/calendar/cal-french.el (calendar-french-trim-feast): Doc fix. diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index cc18a2a5d8..1789f16445 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -215,8 +215,8 @@ calendar-french-special-days-array) (defun calendar-french-trim-feast (feast) - "Remove the article from the feast, e.g. \"du Raisin\" -> \"Raisin\" -or \"de la Vertu\" -> \"Vertu\"" + "Remove the article from the FEAST. +E.g. \"du Raisin\" -> \"Raisin\" or \"de la Vertu\" -> \"Vertu\"." (cond ((equal (substring feast 0 3) "du ") (substring feast 3)) ((equal (substring feast 0 6) "de la ") (substring feast 6)) commit 570832256061a70caf8b0892d3fb92c36fe28988 Author: Eli Zaretskii Date: Fri Jul 23 22:43:22 2021 +0300 ; * lisp/files.el (set-auto-mode--apply-alist): Doc fix. diff --git a/lisp/files.el b/lisp/files.el index c0effd1ad6..d915c2a30b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3200,9 +3200,10 @@ Also applies to `magic-fallback-mode-alist'.") This function takes an alist of the same form as `auto-mode-alist'. It then tries to find the appropriate match in the alist for the current buffer; setting the mode if -possible. Returns non-`nil' if the mode was set, `nil' -otherwise. DIR-LOCAL is a boolean which, if true, says that this -call is via directory-locals and extra checks should be done." +possible. +Return non-nil if the mode was set, nil otherwise. +DIR-LOCAL non-nil means this call is via directory-locals, and +extra checks should be done." (if buffer-file-name (let (mode (name buffer-file-name) commit 1163217725243c250a0c8adbf06bccff35035db5 Author: Eli Zaretskii Date: Fri Jul 23 22:38:10 2021 +0300 Improve recently added documentation * etc/NEWS: Improve wording of a recently added entry. * doc/misc/smtpmail.texi (Queued delivery): Fix typo. diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi index 8a19744f91..ca7dabe654 100644 --- a/doc/misc/smtpmail.texi +++ b/doc/misc/smtpmail.texi @@ -342,9 +342,9 @@ internet). @vindex smtpmail-store-queue-variables Normally the queue will be dispatched with the values of the @acronym{SMTP} variables that are in effect when @kbd{M-x -smtpmail-send-queued-mail} is executed, but if this +smtpmail-send-queued-mail} is executed, but if @code{smtpmail-store-queue-variables} is non-@code{nil}, the values -for @code{smtpmail-smtp-server} (etc.) will be stored when the mail is +for @code{smtpmail-smtp-server} (etc.@:) will be stored when the mail is queued, and then used when actually sending the mail. This can be useful if you have a complex outgoing mail setup. diff --git a/etc/NEWS b/etc/NEWS index 7d082f68e9..37472b7f63 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1145,8 +1145,9 @@ take the actual screenshot, and defaults to "ImageMagick import". +++ *** New user option 'smtpmail-store-queue-variables'. -If non-nil, SMTP variables will be stored in the queue and then used -when sending with 'M-x smtpmail-send-queued-mail'. +If non-nil, SMTP variables will be stored together with the queued +messages, and will then be used when sending with +'M-x smtpmail-send-queued-mail'. +++ *** Allow direct selection of smtp authentication mechanism. commit 8ec35857cf0ae3a18e2267cd8460cf898bcb338f Merge: eb20d013a1 2a231378fa Author: Michael Albinus Date: Fri Jul 23 20:30:46 2021 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit eb20d013a1717a0ecc6ee3563e69261aaf7c98eb Author: Alex Bochannek Date: Fri Jul 23 20:29:59 2021 +0200 Fix bug#49699 * lisp/net/tramp-sh.el (tramp-scp-strict-file-name-checking): Adapt check for macOS. (Bug#49699) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8b4c78fe65..f94508303d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4782,7 +4782,9 @@ Goes through the list `tramp-inline-compress-commands'." (with-temp-buffer (tramp-call-process vec "scp" nil t nil "-T") (goto-char (point-min)) - (unless (search-forward-regexp "unknown option -- T" nil t) + (unless + (search-forward-regexp + "\\(illegal\\|unknown\\) option -- T" nil t) (setq tramp-scp-strict-file-name-checking "-T"))))))) tramp-scp-strict-file-name-checking))) commit 2a231378fa5b10049b52c9197f037b522e0d22a1 Author: Lars Ingebrigtsen Date: Fri Jul 23 20:18:21 2021 +0200 Fix typo in set-auto-mode--apply-alist * lisp/files.el (set-auto-mode--apply-alist): Fix typo in ad5faa424a5 (bug#49712). diff --git a/lisp/files.el b/lisp/files.el index dc803d3a4c..c0effd1ad6 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3221,7 +3221,7 @@ call is via directory-locals and extra checks should be done." (if case-insensitive-p ;; Filesystem is case-insensitive. (let ((case-fold-search t)) - (assoc-default alist 'string-match)) + (assoc-default name alist 'string-match)) ;; Filesystem is case-sensitive. (or ;; First match case-sensitively. commit 1f24519735d5413916962ff659d78b7333904e11 Author: Lars Ingebrigtsen Date: Fri Jul 23 17:58:20 2021 +0200 Allow storing SMTP variables when queueing mail * doc/misc/smtpmail.texi (Queued delivery): Document it (bug#49709). * lisp/gnus/message.el (message-multi-smtp-send-mail): Store variables. * lisp/mail/smtpmail.el (smtpmail-queue-mail): Mention it. (smtpmail-store-queue-variables): New variable. (smtpmail-send-it): Store SMTP variables if requested. (smtpmail-send-queued-mail): Restore variables. diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi index dd481d2101..8a19744f91 100644 --- a/doc/misc/smtpmail.texi +++ b/doc/misc/smtpmail.texi @@ -338,6 +338,16 @@ not sent immediately but rather queued in the directory @code{smtpmail-send-queued-mail} (typically when you connect to the internet). +@item smtpmail-store-queue-variables +@vindex smtpmail-store-queue-variables + Normally the queue will be dispatched with the values of the +@acronym{SMTP} variables that are in effect when @kbd{M-x +smtpmail-send-queued-mail} is executed, but if this +@code{smtpmail-store-queue-variables} is non-@code{nil}, the values +for @code{smtpmail-smtp-server} (etc.) will be stored when the mail is +queued, and then used when actually sending the mail. This can be +useful if you have a complex outgoing mail setup. + @item smtpmail-queue-dir @vindex smtpmail-queue-dir The variable @code{smtpmail-queue-dir} specifies the name of the diff --git a/etc/NEWS b/etc/NEWS index c7249456ff..7d082f68e9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1143,6 +1143,11 @@ take the actual screenshot, and defaults to "ImageMagick import". ** Smtpmail ++++ +*** New user option 'smtpmail-store-queue-variables'. +If non-nil, SMTP variables will be stored in the queue and then used +when sending with 'M-x smtpmail-send-queued-mail'. + +++ *** Allow direct selection of smtp authentication mechanism. A server entry retrieved by auth-source can request a desired smtp diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index cdabdef2ec..9baf09b026 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4922,6 +4922,7 @@ Each line should be no more than 79 characters long." (defvar smtpmail-smtp-service) (defvar smtpmail-smtp-user) (defvar smtpmail-stream-type) +(defvar smtpmail-store-queue-variables) (defun message-multi-smtp-send-mail () "Send the current buffer to `message-send-mail-function'. @@ -4937,7 +4938,8 @@ that instead." (message-send-mail-with-sendmail)) ((equal (car method) "smtp") (require 'smtpmail) - (let* ((smtpmail-smtp-server (nth 1 method)) + (let* ((smtpmail-store-queue-variables t) + (smtpmail-smtp-server (nth 1 method)) (service (nth 2 method)) (port (string-to-number service)) ;; If we're talking to the TLS SMTP port, then force a diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index c1e2280033..133a2e1828 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -135,8 +135,9 @@ Used for the value of `sendmail-coding-system' when (defcustom smtpmail-queue-mail nil "Non-nil means mail is queued; otherwise it is sent immediately. -If queued, it is stored in the directory `smtpmail-queue-dir' -and sent with `smtpmail-send-queued-mail'." +If queued, it is stored in the directory `smtpmail-queue-dir' and +sent with `smtpmail-send-queued-mail'. Also see +`smtpmail-store-queue-variables'." :type 'boolean) (defcustom smtpmail-queue-dir "~/Mail/queued-mail/" @@ -173,10 +174,21 @@ mean \"try again\"." :type 'integer :version "27.1") +(defcustom smtpmail-store-queue-variables nil + "If non-nil, store SMTP variables when queueing mail. +These will then be used when sending the queue." + :type 'boolean + :version "28.1") + ;;; Variables (defvar smtpmail-address-buffer) -(defvar smtpmail-recipient-address-list) +(defvar smtpmail-recipient-address-list nil) +(defvar smtpmail--stored-queue-variables + '(smtpmail-smtp-server + smtpmail-stream-type + smtpmail-smtp-service + smtpmail-smtp-user)) (defvar smtpmail-queue-counter 0) @@ -387,11 +399,17 @@ for `smtpmail-try-auth-method'.") nil t) (insert-buffer-substring tembuf) (write-file file-data) - (write-region - (concat "(setq smtpmail-recipient-address-list '" - (prin1-to-string smtpmail-recipient-address-list) - ")\n") - nil file-elisp nil 'silent) + (let ((coding-system-for-write 'utf-8)) + (with-temp-buffer + (insert "(setq ") + (dolist (var (cons 'smtpmail-recipient-address-list + ;; Perhaps store the server etc. + (and smtpmail-store-queue-variables + smtpmail--stored-queue-variables))) + (insert (format " %s %S\n" var (symbol-value var)))) + (insert ")\n") + (write-region (point-min) (point-max) file-elisp + nil 'silent))) (write-region (concat file-data "\n") nil (expand-file-name smtpmail-queue-index-file smtpmail-queue-dir) @@ -411,26 +429,30 @@ for `smtpmail-try-auth-method'.") (let (file-data file-elisp (qfile (expand-file-name smtpmail-queue-index-file smtpmail-queue-dir)) + (stored (cons 'smtpmail-recipient-address-list + smtpmail--stored-queue-variables)) + smtpmail-recipient-address-list + (smtpmail-smtp-server smtpmail-smtp-server) + (smtpmail-stream-type smtpmail-stream-type) + (smtpmail-smtp-service smtpmail-smtp-service) + (smtpmail-smtp-user smtpmail-smtp-user) result) (insert-file-contents qfile) (goto-char (point-min)) (while (not (eobp)) (setq file-data (buffer-substring (point) (line-end-position))) (setq file-elisp (concat file-data ".el")) - ;; FIXME: Avoid `load' which can execute arbitrary code and is hence - ;; a source of security holes. Better read the file and extract the - ;; data "by hand". - ;;(load file-elisp) - (with-temp-buffer - (insert-file-contents file-elisp) - (goto-char (point-min)) - (pcase (read (current-buffer)) - (`(setq smtpmail-recipient-address-list ',v) - (skip-chars-forward " \n\t") - (unless (eobp) (message "Ignoring trailing text in %S" - file-elisp)) - (setq smtpmail-recipient-address-list v)) - (sexp (error "Unexpected code in %S: %S" file-elisp sexp)))) + (let ((coding-system-for-read 'utf-8)) + (with-temp-buffer + (insert-file-contents file-elisp) + (let ((form (read (current-buffer)))) + (when (or (not (consp form)) + (not (eq (car form) 'setq)) + (not (consp (cdr form)))) + (error "Unexpected code in %S: %S" file-elisp form)) + (cl-loop for (var val) on (cdr form) by #'cddr + when (memq var stored) + do (set var val))))) ;; Insert the message literally: it is already encoded as per ;; the MIME headers, and code conversions might guess the ;; encoding wrongly. @@ -445,13 +467,13 @@ for `smtpmail-try-auth-method'.") (message-narrow-to-headers) (mail-envelope-from))) user-mail-address))) - (if (not (null smtpmail-recipient-address-list)) - (when (setq result (smtpmail-via-smtp - smtpmail-recipient-address-list - (current-buffer))) - (error "Sending failed: %s" - (smtpmail--sanitize-error-message result))) - (error "Sending failed; no recipients")))) + (if (not smtpmail-recipient-address-list) + (error "Sending failed; no recipients") + (when (setq result (smtpmail-via-smtp + smtpmail-recipient-address-list + (current-buffer))) + (error "Sending failed: %s" + (smtpmail--sanitize-error-message result)))))) (delete-file file-data) (delete-file file-elisp) (delete-region (point-at-bol) (point-at-bol 2))) commit 6ce2acdadb7467fbde01f3d0648acea158836614 Author: Lars Ingebrigtsen Date: Fri Jul 23 15:56:44 2021 +0200 Fix do-auto-fill thinko introduced earlier today * lisp/simple.el (do-auto-fill): `current-fill-column' returns nil to signal that we should fill. diff --git a/lisp/simple.el b/lisp/simple.el index ee2698dc67..1a49fe2425 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8057,7 +8057,7 @@ Returns t if it really did any work." (let (fc justify give-up (fill-prefix fill-prefix)) (if (or (not (setq justify (current-justification))) - (setq fc (current-fill-column)) + (null (setq fc (current-fill-column))) (and (eq justify 'left) (<= (current-column) fc)) (and auto-fill-inhibit-regexp commit ad5faa424a5d2f0d67265906d21f7af98220df26 Author: Tom Tromey Date: Fri Jul 23 15:51:11 2021 +0200 Add auto-mode-alist functionality to .dir-locals.el * doc/emacs/custom.texi (Directory Variables): Document auto-mode-alist in .dir-locals.el (Bug#18721) * doc/emacs/modes.texi (Choosing Modes): Update. * lisp/files.el (set-auto-mode--apply-alist): New function, from set-auto-mode. (set-auto-mode): Check directory locals for auto-mode-alist. (dir-locals-collect-variables): Add "predicate" parameter. (hack-dir-local--get-variables): New function, from hack-dir-local-variables. (hack-dir-local-variables): Call hack-dir-local--get-variables. * test/lisp/files-resources/.dir-locals.el: New file. * test/lisp/files-resources/whatever.quux: New file. * test/lisp/files-tests.el (files-tests-data-dir): New variable. (files-test-dir-locals-auto-mode-alist): New test. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index ce6290c117..999234e6d3 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1415,6 +1415,16 @@ meanings as they would have in file local variables. @code{coding} cannot be specified as a directory local variable. @xref{File Variables}. +The special key @code{auto-mode-alist} in a @file{.dir-locals.el} lets +you set a file's major mode. It works much like the variable +@code{auto-mode-alist} (@pxref{Choosing Modes}). For example, here is +how you can tell Emacs that @file{.def} source files in this directory +should be in C mode: + +@example +((auto-mode-alist . (("\\.def\\'" . c-mode)))) +@end example + @findex add-dir-local-variable @findex delete-dir-local-variable @findex copy-file-locals-to-dir-locals diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index cc25d3e1e3..9014221edf 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -357,8 +357,12 @@ preferences. If you personally want to use a minor mode for a particular file type, it is better to enable the minor mode via a major mode hook (@pxref{Major Modes}). + Second, Emacs checks whether the file's extension matches an entry +in any directory-local @code{auto-mode-alist}. These are found using +the @file{.dir-locals.el} facility (@pxref{Directory Variables}). + @vindex interpreter-mode-alist - Second, if there is no file variable specifying a major mode, Emacs + Third, if there is no file variable specifying a major mode, Emacs checks whether the file's contents begin with @samp{#!}. If so, that indicates that the file can serve as an executable shell command, which works by running an interpreter named on the file's first line @@ -376,7 +380,7 @@ same is true for man pages which start with the magic string @samp{'\"} to specify a list of troff preprocessors. @vindex magic-mode-alist - Third, Emacs tries to determine the major mode by looking at the + Fourth, Emacs tries to determine the major mode by looking at the text at the start of the buffer, based on the variable @code{magic-mode-alist}. By default, this variable is @code{nil} (an empty list), so Emacs skips this step; however, you can customize it @@ -404,7 +408,7 @@ where @var{match-function} is a Lisp function that is called at the beginning of the buffer; if the function returns non-@code{nil}, Emacs set the major mode with @var{mode-function}. - Fourth---if Emacs still hasn't found a suitable major mode---it + Fifth---if Emacs still hasn't found a suitable major mode---it looks at the file's name. The correspondence between file names and major modes is controlled by the variable @code{auto-mode-alist}. Its value is a list in which each element has this form, diff --git a/etc/NEWS b/etc/NEWS index 29953a8fa2..c7249456ff 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2289,6 +2289,12 @@ This command, called interactively, toggles the local value of ** Miscellaneous ++++ +*** .dir-locals.el now supports setting 'auto-mode-alist'. +The new 'auto-mode-alist' specification in .dir-local.el files can now +be used to override the global 'auto-mode-alist' in the current +directory tree. + --- *** New utility function 'make-separator-line'. diff --git a/lisp/files.el b/lisp/files.el index 412562fc9a..dc803d3a4c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3195,11 +3195,62 @@ If FUNCTION is nil, then it is not called.") "Upper limit on `magic-mode-alist' regexp matches. Also applies to `magic-fallback-mode-alist'.") +(defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local) + "Helper function for `set-auto-mode'. +This function takes an alist of the same form as +`auto-mode-alist'. It then tries to find the appropriate match +in the alist for the current buffer; setting the mode if +possible. Returns non-`nil' if the mode was set, `nil' +otherwise. DIR-LOCAL is a boolean which, if true, says that this +call is via directory-locals and extra checks should be done." + (if buffer-file-name + (let (mode + (name buffer-file-name) + (remote-id (file-remote-p buffer-file-name)) + (case-insensitive-p (file-name-case-insensitive-p + buffer-file-name))) + ;; Remove backup-suffixes from file name. + (setq name (file-name-sans-versions name)) + ;; Remove remote file name identification. + (when (and (stringp remote-id) + (string-match (regexp-quote remote-id) name)) + (setq name (substring name (match-end 0)))) + (while name + ;; Find first matching alist entry. + (setq mode + (if case-insensitive-p + ;; Filesystem is case-insensitive. + (let ((case-fold-search t)) + (assoc-default alist 'string-match)) + ;; Filesystem is case-sensitive. + (or + ;; First match case-sensitively. + (let ((case-fold-search nil)) + (assoc-default name alist 'string-match)) + ;; Fallback to case-insensitive match. + (and auto-mode-case-fold + (let ((case-fold-search t)) + (assoc-default name alist 'string-match)))))) + (if (and mode + (consp mode) + (cadr mode)) + (setq mode (car mode) + name (substring name 0 (match-beginning 0))) + (setq name nil))) + (when (and dir-local mode) + (unless (string-suffix-p "-mode" (symbol-name mode)) + (message "Ignoring invalid mode `%s'" (symbol-name mode)) + (setq mode nil))) + (when mode + (set-auto-mode-0 mode keep-mode-if-same) + t)))) + (defun set-auto-mode (&optional keep-mode-if-same) "Select major mode appropriate for current buffer. To find the right major mode, this function checks for a -*- mode tag checks for a `mode:' entry in the Local Variables section of the file, +checks if there an `auto-mode-alist' entry in `.dir-locals.el', checks if it uses an interpreter listed in `interpreter-mode-alist', matches the buffer beginning against `magic-mode-alist', compares the file name against the entries in `auto-mode-alist', @@ -3256,6 +3307,14 @@ we don't actually set it to the same mode the buffer already has." (or (set-auto-mode-0 mode keep-mode-if-same) ;; continuing would call minor modes again, toggling them off (throw 'nop nil)))))) + ;; Check for auto-mode-alist entry in dir-locals. + (unless done + (with-demoted-errors "Directory-local variables error: %s" + ;; Note this is a no-op if enable-local-variables is nil. + (let* ((mode-alist (cdr (hack-dir-local--get-variables + (lambda (key) (eq key 'auto-mode-alist)))))) + (setq done (set-auto-mode--apply-alist mode-alist + keep-mode-if-same t))))) (and (not done) (setq mode (hack-local-variables t (not try-locals))) (not (memq mode modes)) ; already tried and failed @@ -3307,45 +3366,8 @@ we don't actually set it to the same mode the buffer already has." (set-auto-mode-0 done keep-mode-if-same))) ;; Next compare the filename against the entries in auto-mode-alist. (unless done - (if buffer-file-name - (let ((name buffer-file-name) - (remote-id (file-remote-p buffer-file-name)) - (case-insensitive-p (file-name-case-insensitive-p - buffer-file-name))) - ;; Remove backup-suffixes from file name. - (setq name (file-name-sans-versions name)) - ;; Remove remote file name identification. - (when (and (stringp remote-id) - (string-match (regexp-quote remote-id) name)) - (setq name (substring name (match-end 0)))) - (while name - ;; Find first matching alist entry. - (setq mode - (if case-insensitive-p - ;; Filesystem is case-insensitive. - (let ((case-fold-search t)) - (assoc-default name auto-mode-alist - 'string-match)) - ;; Filesystem is case-sensitive. - (or - ;; First match case-sensitively. - (let ((case-fold-search nil)) - (assoc-default name auto-mode-alist - 'string-match)) - ;; Fallback to case-insensitive match. - (and auto-mode-case-fold - (let ((case-fold-search t)) - (assoc-default name auto-mode-alist - 'string-match)))))) - (if (and mode - (consp mode) - (cadr mode)) - (setq mode (car mode) - name (substring name 0 (match-beginning 0))) - (setq name nil)) - (when mode - (set-auto-mode-0 mode keep-mode-if-same) - (setq done t)))))) + (setq done (set-auto-mode--apply-alist auto-mode-alist + keep-mode-if-same nil))) ;; Next try matching the buffer beginning against magic-fallback-mode-alist. (unless done (if (setq done (save-excursion @@ -4166,10 +4188,13 @@ Returns the new list." ;; Need a new cons in case we setcdr later. (push (cons variable value) variables))))) -(defun dir-locals-collect-variables (class-variables root variables) +(defun dir-locals-collect-variables (class-variables root variables + &optional predicate) "Collect entries from CLASS-VARIABLES into VARIABLES. ROOT is the root directory of the project. -Return the new variables list." +Return the new variables list. +If PREDICATE is given, it is used to test a symbol key in the alist +to see whether it should be considered." (let* ((file-name (or (buffer-file-name) ;; Handle non-file buffers, too. (expand-file-name default-directory))) @@ -4188,9 +4213,11 @@ Return the new variables list." (>= (length sub-file-name) (length key)) (string-prefix-p key sub-file-name)) (setq variables (dir-locals-collect-variables - (cdr entry) root variables)))) - ((or (not key) - (derived-mode-p key)) + (cdr entry) root variables predicate)))) + ((if predicate + (funcall predicate key) + (or (not key) + (derived-mode-p key))) (let* ((alist (cdr entry)) (subdirs (assq 'subdirs alist))) (if (or (not subdirs) @@ -4487,13 +4514,13 @@ Return the new class name, which is a symbol named DIR." (defvar hack-dir-local-variables--warned-coding nil) -(defun hack-dir-local-variables () +(defun hack-dir-local--get-variables (predicate) "Read per-directory local variables for the current buffer. -Store the directory-local variables in `dir-local-variables-alist' -and `file-local-variables-alist', without applying them. - -This does nothing if either `enable-local-variables' or -`enable-dir-local-variables' are nil." +Return a cons of the form (DIR . ALIST), where DIR is the +directory name (maybe nil) and ALIST is an alist of all variables +that might apply. These will be filtered according to the +buffer's directory, but not according to its mode. +PREDICATE is passed to `dir-locals-collect-variables'." (when (and enable-local-variables enable-dir-local-variables (or enable-remote-dir-locals @@ -4512,21 +4539,33 @@ This does nothing if either `enable-local-variables' or (setq dir-name (nth 0 dir-or-cache)) (setq class (nth 1 dir-or-cache)))) (when class - (let ((variables - (dir-locals-collect-variables - (dir-locals-get-class-variables class) dir-name nil))) - (when variables - (dolist (elt variables) - (if (eq (car elt) 'coding) - (unless hack-dir-local-variables--warned-coding - (setq hack-dir-local-variables--warned-coding t) - (display-warning 'files - "Coding cannot be specified by dir-locals")) - (unless (memq (car elt) '(eval mode)) - (setq dir-local-variables-alist - (assq-delete-all (car elt) dir-local-variables-alist))) - (push elt dir-local-variables-alist))) - (hack-local-variables-filter variables dir-name))))))) + (cons dir-name + (dir-locals-collect-variables + (dir-locals-get-class-variables class) + dir-name nil predicate)))))) + +(defun hack-dir-local-variables () + "Read per-directory local variables for the current buffer. +Store the directory-local variables in `dir-local-variables-alist' +and `file-local-variables-alist', without applying them. + +This does nothing if either `enable-local-variables' or +`enable-dir-local-variables' are nil." + (let* ((items (hack-dir-local--get-variables nil)) + (dir-name (car items)) + (variables (cdr items))) + (when variables + (dolist (elt variables) + (if (eq (car elt) 'coding) + (unless hack-dir-local-variables--warned-coding + (setq hack-dir-local-variables--warned-coding t) + (display-warning 'files + "Coding cannot be specified by dir-locals")) + (unless (memq (car elt) '(eval mode)) + (setq dir-local-variables-alist + (assq-delete-all (car elt) dir-local-variables-alist))) + (push elt dir-local-variables-alist))) + (hack-local-variables-filter variables dir-name)))) (defun hack-dir-local-variables-non-file-buffer () "Apply directory-local variables to a non-file buffer. diff --git a/test/lisp/files-resources/.dir-locals.el b/test/lisp/files-resources/.dir-locals.el new file mode 100644 index 0000000000..84997b8a0c --- /dev/null +++ b/test/lisp/files-resources/.dir-locals.el @@ -0,0 +1,2 @@ +;; This is used by files-tests.el. +((auto-mode-alist . (("\\.quux\\'" . tcl-mode)))) diff --git a/test/lisp/files-resources/whatever.quux b/test/lisp/files-resources/whatever.quux new file mode 100644 index 0000000000..595583b911 --- /dev/null +++ b/test/lisp/files-resources/whatever.quux @@ -0,0 +1,2 @@ +# Used by files-test.el. +# Due to .dir-locals.el this should end up in Tcl mode. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index a6b0c900be..fce7e3fd71 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1534,5 +1534,10 @@ The door of all subtleties! (should-error (file-name-with-extension "Jack" ".")) (should-error (file-name-with-extension "/is/a/directory/" "css"))) +(ert-deftest files-test-dir-locals-auto-mode-alist () + "Test an `auto-mode-alist' entry in `.dir-locals.el'" + (find-file (ert-resource-file "whatever.quux")) + (should (eq major-mode 'tcl-mode))) + (provide 'files-tests) ;;; files-tests.el ends here commit 6a3b89f9df85d0718e55d460164ff65e7bdd823e Author: Jean Forget Date: Fri Jul 23 15:26:40 2021 +0200 Add more support for the French Revolutionary Calendar * lisp/calendar/cal-french.el (calendar-french-feasts-array): New variable (bug#19174). (calendar-french-trim-feast): New function. (calendar-french-date-string, calendar-french-goto-date): (calendar-french-goto-date): Use them. http://datetime.mongueurs.net/Histoire/s-c/01-g.en.html https://metacpan.org/pod/DateTime::Calendar::FrenchRevolutionary#Internet diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index 639bae700c..cc18a2a5d8 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -40,12 +40,13 @@ (defconst calendar-french-month-name-array ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" - "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"] + "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor" + "jour complémentaire"] "Array of month names in the French calendar.") (defconst calendar-french-day-name-array ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" - "Octidi" "Nonidi" "Decadi"] + "Octidi" "Nonidi" "Décadi"] "Array of day names in the French calendar.") (define-obsolete-variable-alias 'calendar-french-multibyte-special-days-array @@ -56,6 +57,144 @@ "de la Révolution"] "Array of special day names in the French calendar.") +(defconst calendar-french-feasts-array + [;; Vendémiaire + "du Raisin" "du Safran" "de la Châtaigne" + "de la Colchique" "du Cheval" "de la Balsamine" + "de la Carotte" "de l'Amarante" "du Panais" + "de la Cuve" "de la Pomme de terre" "de l'Immortelle" + "du Potiron" "du Réséda" "de l'Âne" + "de la Belle de nuit" "de la Citrouille" "du Sarrasin" + "du Tournesol" "du Pressoir" "du Chanvre" + "de la Pêche" "du Navet" "de l'Amaryllis" + "du Bœuf" "de l'Aubergine" "du Piment" + "de la Tomate" "de l'Orge" "du Tonneau" + ;; Brumaire + "de la Pomme" "du Céleri" "de la Poire" + "de la Betterave" "de l'Oie" "de l'Héliotrope" + "de la Figue" "de la Scorsonère" "de l'Alisier" + "de la Charrue" "du Salsifis" "de la Macre" + "du Topinambour" "de l'Endive" "du Dindon" + "du Chervis" "du Cresson" "de la Dentelaire" + "de la Grenade" "de la Herse" "de la Bacchante" + "de l'Azerole" "de la Garance" "de l'Orange" + "du Faisan" "de la Pistache" "du Macjon" + "du Coing" "du Cormier" "du Rouleau" + ;; Frimaire + "de la Raiponce" "du Turneps" "de la Chicorée" + "de la Nèfle" "du Cochon" "de la Mâche" + "du Chou-fleur" "du Miel" "du Genièvre" + "de la Pioche" "de la Cire" "du Raifort" + "du Cèdre" "du Sapin" "du Chevreuil" + "de l'Ajonc" "du Cyprès" "du Lierre" + "de la Sabine" "du Hoyau" "de l'Érable-sucre" + "de la Bruyère" "du Roseau" "de l'Oseille" + "du Grillon" "du Pignon" "du Liège" + "de la Truffe" "de l'Olive" "de la Pelle" + ;; Nivôse + "de la Tourbe" "de la Houille" "du Bitume" + "du Soufre" "du Chien" "de la Lave" + "de la Terre végétale" "du Fumier" "du Salpêtre" + "du Fléau" "du Granit" "de l'Argile" + "de l'Ardoise" "du Grès" "du Lapin" + "du Silex" "de la Marne" "de la Pierre à chaux" + "du Marbre" "du Van" "de la Pierre à plâtre" + "du Sel" "du Fer" "du Cuivre" + "du Chat" "de l'Étain" "du Plomb" + "du Zinc" "du Mercure" "du Crible" + ;; Pluviôse + "de la Lauréole" "de la Mousse" "du Fragon" + "du Perce-neige" "du Taureau" "du Laurier-thym" + "de l'Amadouvier" "du Mézéréon" "du Peuplier" + "de la Cognée" "de l'Ellébore" "du Brocoli" + "du Laurier" "de l'Avelinier" "de la Vache" + "du Buis" "du Lichen" "de l'If" + "de la Pulmonaire" "de la Serpette" "du Thlaspi" + "du Thymelé" "du Chiendent" "de la Traînasse" + "du Lièvre" "de la Guède" "du Noisetier" + "du Cyclamen" "de la Chélidoine" "du Traîneau" + ;; Ventôse + "du Tussilage" "du Cornouiller" "du Violier" + "du Troène" "du Bouc" "de l'Asaret" + "de l'Alaterne" "de la Violette" "du Marsault" + "de la Bêche" "du Narcisse" "de l'Orme" + "de la Fumeterre" "du Vélar" "de la Chèvre" + "de l'Épinard" "du Doronic" "du Mouron" + "du Cerfeuil" "du Cordeau" "de la Mandragore" + "du Persil" "du Cochléaria" "de la Pâquerette" + "du Thon" "du Pissenlit" "de la Sylvie" + "du Capillaire" "du Frêne" "du Plantoir" + ;; Germinal + "de la Primevère" "du Platane" "de l'Asperge" + "de la Tulipe" "de la Poule" "de la Blette" + "du Bouleau" "de la Jonquille" "de l'Aulne" + "du Couvoir" "de la Pervenche" "du Charme" + "de la Morille" "du Hêtre" "de l'Abeille" + "de la Laitue" "du Mélèze" "de la Ciguë" + "du Radis" "de la Ruche" "du Gainier" + "de la Romaine" "du Marronnier" "de la Roquette" + "du Pigeon" "du Lilas" "de l'Anémone" + "de la Pensée" "de la Myrtille" "du Greffoir" + ;; Floréal + "de la Rose" "du Chêne" "de la Fougère" + "de l'Aubépine" "du Rossignol" "de l'Ancolie" + "du Muguet" "du Champignon" "de la Jacinthe" + "du Rateau" "de la Rhubarbe" "du Sainfoin" + "du Bâton-d'or" "du Chamérisier" "du Ver à soie" + "de la Consoude" "de la Pimprenelle" "de la Corbeille-d'or" + "de l'Arroche" "du Sarcloir" "du Statice" + "de la Fritillaire" "de la Bourrache" "de la Valériane" + "de la Carpe" "du Fusain" "de la Civette" + "de la Buglosse" "du Sénevé" "de la Houlette" + ;; Prairial + "de la Luzerne" "de l'Hémérocalle" "du Trèfle" + "de l'Angélique" "du Canard" "de la Mélisse" + "du Fromental" "du Martagon" "du Serpolet" + "de la Faux" "de la Fraise" "de la Bétoine" + "du Pois" "de l'Acacia" "de la Caille" + "de l'Œillet" "du Sureau" "du Pavot" + "du Tilleul" "de la Fourche" "du Barbeau" + "de la Camomille" "du Chèvrefeuille" "du Caille-lait" + "de la Tanche" "du Jasmin" "de la Verveine" + "du Thym" "de la Pivoine" "du Chariot" + ;; Messidor + "du Seigle" "de l'Avoine" "de l'Oignon" + "de la Véronique" "du Mulet" "du Romarin" + "du Concombre" "de l'Échalotte" "de l'Absinthe" + "de la Faucille" "de la Coriandre" "de l'Artichaut" + "de la Giroflée" "de la Lavande" "du Chamois" + "du Tabac" "de la Groseille" "de la Gesse" + "de la Cerise" "du Parc" "de la Menthe" + "du Cumin" "du Haricot" "de l'Orcanète" + "de la Pintade" "de la Sauge" "de l'Ail" + "de la Vesce" "du Blé" "de la Chalémie" + ;; Thermidor + "de l'Épautre" "du Bouillon-blanc" "du Melon" + "de l'Ivraie" "du Bélier" "de la Prèle" + "de l'Armoise" "du Carthame" "de la Mûre" + "de l'Arrosoir" "du Panis" "du Salicor" + "de l'Abricot" "du Basilic" "de la Brebis" + "de la Guimauve" "du Lin" "de l'Amande" + "de la Gentiane" "de l'Écluse" "de la Carline" + "du Câprier" "de la Lentille" "de l'Aunée" + "de la Loutre" "de la Myrte" "du Colza" + "du Lupin" "du Coton" "du Moulin" + ;; Fructidor + "de la Prune" "du Millet" "du Lycoperdon" + "de l'Escourgeon" "du Saumon" "de la Tubéreuse" + "du Sucrion" "de l'Apocyn" "de la Réglisse" + "de l'Échelle" "de la Pastèque" "du Fenouil" + "de l'Épine-vinette" "de la Noix" "de la Truite" + "du Citron" "de la Cardère" "du Nerprun" + "du Tagette" "de la Hotte" "de l'Églantier" + "de la Noisette" "du Houblon" "du Sorgho" + "de l'Écrevisse" "de la Bagarade" "de la Verge-d'or" + "du Maïs" "du Marron" "du Panier" + ;; jour complémentaire + "de la Vertu" "du Génie" "du Travail" + "de la Raison" "des Récompenses" "de la Révolution"] + "Array of day feasts in the French calendar.") + (defun calendar-french-accents-p () (declare (obsolete nil "28.1")) t) @@ -75,6 +214,16 @@ (declare (obsolete "use the variable of the same name instead" "28.1")) calendar-french-special-days-array) +(defun calendar-french-trim-feast (feast) + "Remove the article from the feast, e.g. \"du Raisin\" -> \"Raisin\" +or \"de la Vertu\" -> \"Vertu\"" + (cond + ((equal (substring feast 0 3) "du ") (substring feast 3)) + ((equal (substring feast 0 6) "de la ") (substring feast 6)) + ((equal (substring feast 0 5) "de l'") (substring feast 5)) + ((equal (substring feast 0 4) "des ") (substring feast 4)) + (t feast))) + (defun calendar-french-leap-year-p (year) "True if YEAR is a leap year on the French Revolutionary calendar. For Gregorian years 1793 to 1805, the years of actual operation of the @@ -162,14 +311,13 @@ Defaults to today's date if DATE is not given." (d (calendar-extract-day french-date))) (cond ((< y 1) "") - ((= m 13) (format "Jour %s de l'Année %d de la Révolution" - (aref calendar-french-special-days-array (1- d)) - y)) (t (format - "%d %s an %d de la Révolution" + "%s %d %s an %d de la Révolution, jour %s" + (aref calendar-french-day-name-array (% (1- d) 10)) d (aref calendar-french-month-name-array (1- m)) - y))))) + y + (aref calendar-french-feasts-array (+ -31 (* 30 m) d))))))) ;;;###cal-autoload (defun calendar-french-print-date () @@ -186,7 +334,7 @@ Defaults to today's date if DATE is not given." Echo French Revolutionary date unless NOECHO is non-nil." (interactive (let* ((months calendar-french-month-name-array) - (special-days calendar-french-special-days-array) + (feasts calendar-french-feasts-array) (year (progn (calendar-read-sexp "Année de la Révolution (>0)" @@ -199,29 +347,31 @@ Echo French Revolutionary date unless NOECHO is non-nil." (mapcar 'list (append months (if (calendar-french-leap-year-p year) - (mapcar - (lambda (x) (concat "Jour " x)) - calendar-french-special-days-array) + (mapcar #'calendar-french-trim-feast feasts) (reverse (cdr ; we don't want rev. day in a non-leap yr (reverse - (mapcar - (lambda (x) - (concat "Jour " x)) - special-days)))))))) + (mapcar #'calendar-french-trim-feast + feasts)))))))) (completion-ignore-case t) (month (cdr (assoc-string (completing-read - "Mois ou Sansculottide: " + "Mois ou \"jour complémentaire\" ou fête: " month-list nil t) (calendar-make-alist month-list 1 'car) t))) - (day (if (> month 12) - (- month 12) + (last-day (calendar-french-last-day-of-month (min month 13) year)) + (day (if (> month 13) + (- month 13) (calendar-read-sexp - "Jour (1-30)" - (lambda (x) (and (<= 1 x) (<= x 30)))))) - (month (if (> month 12) 13 month))) + (format "Jour (1-%d): " last-day) + (lambda (x) (<= 1 x last-day))))) + ;; All days in Vendémiaire and numbered 1 to 365 e.g., "Pomme" + ;; gives 31 Vendémiaire automatically normalized to 1 Brumaire + ;; "Céleri" gives 32 Vnd normalized to 2 Bru, "Raiponce" gives + ;; 61 Vnd normalized to 1 Frimaire, etc until "Récompences" which + ;; gives 365 Vnd normalized to 5 jour complémentaire. + (month (if (> month 13) 1 month))) (list (list month day year)))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-french-to-absolute date))) diff --git a/test/lisp/calendar/cal-french-tests.el b/test/lisp/calendar/cal-french-tests.el new file mode 100644 index 0000000000..ab62c1e6fc --- /dev/null +++ b/test/lisp/calendar/cal-french-tests.el @@ -0,0 +1,113 @@ +;;; cal-french-tests.el --- tests for cal-french.el -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'cal-french) + +(defconst cal-french-test-cases + '( + (1792 9 22 "Primidi 1 Vendémiaire an 1 de la Révolution, jour du Raisin") + (1793 10 23 "Duodi 2 Brumaire an 2 de la Révolution, jour du Céleri") + (1794 7 27 "Nonidi 9 Thermidor an 2 de la Révolution, jour de la Mûre") + (1794 11 23 "Tridi 3 Frimaire an 3 de la Révolution, jour de la Chicorée") + (1795 10 5 "Tridi 13 Vendémiaire an 4 de la Révolution, jour du Potiron") + (1795 12 25 "Quartidi 4 Nivôse an 4 de la Révolution, jour du Soufre") + (1797 1 24 "Quintidi 5 Pluviôse an 5 de la Révolution, jour du Taureau") + (1798 2 24 "Sextidi 6 Ventôse an 6 de la Révolution, jour de l'Asaret") + (1799 11 9 "Octidi 18 Brumaire an 8 de la Révolution, jour de la Dentelaire") + (1801 3 29 "Octidi 8 Germinal an 9 de la Révolution, jour de la Jonquille") + (1804 4 30 "Décadi 10 Floréal an 12 de la Révolution, jour du Rateau") + (1807 6 1 "Duodi 12 Prairial an 15 de la Révolution, jour de la Bétoine") + (1810 7 3 "Quartidi 14 Messidor an 18 de la Révolution, jour de la Lavande") + (1813 8 4 "Sextidi 16 Thermidor an 21 de la Révolution, jour de la Guimauve") + (1816 9 4 "Octidi 18 Fructidor an 24 de la Révolution, jour du Nerprun") + (2000 1 1 "Duodi 12 Nivôse an 208 de la Révolution, jour de l'Argile") + (2021 7 11 "Tridi 23 Messidor an 229 de la Révolution, jour du Haricot") + (2001 5 11 "Duodi 22 Floréal an 209 de la Révolution, jour de la Fritillaire") + (1792 9 22 "Primidi 1 Vendémiaire an 1 de la Révolution, jour du Raisin") + (1793 9 21 "Quintidi 5 jour complémentaire an 1 de la Révolution, jour des Récompenses") + (1793 9 22 "Primidi 1 Vendémiaire an 2 de la Révolution, jour du Raisin") + (1794 9 21 "Quintidi 5 jour complémentaire an 2 de la Révolution, jour des Récompenses") + (1794 9 22 "Primidi 1 Vendémiaire an 3 de la Révolution, jour du Raisin") + (1795 9 22 "Sextidi 6 jour complémentaire an 3 de la Révolution, jour de la Révolution") + (1795 9 23 "Primidi 1 Vendémiaire an 4 de la Révolution, jour du Raisin") + (1796 9 21 "Quintidi 5 jour complémentaire an 4 de la Révolution, jour des Récompenses") + (1796 9 22 "Primidi 1 Vendémiaire an 5 de la Révolution, jour du Raisin") + (1797 9 21 "Quintidi 5 jour complémentaire an 5 de la Révolution, jour des Récompenses") + (1797 9 22 "Primidi 1 Vendémiaire an 6 de la Révolution, jour du Raisin") + (1799 9 22 "Sextidi 6 jour complémentaire an 7 de la Révolution, jour de la Révolution") + (1799 9 23 "Primidi 1 Vendémiaire an 8 de la Révolution, jour du Raisin") + (1800 9 22 "Quintidi 5 jour complémentaire an 8 de la Révolution, jour des Récompenses") + (1800 9 23 "Primidi 1 Vendémiaire an 9 de la Révolution, jour du Raisin") + (1801 9 22 "Quintidi 5 jour complémentaire an 9 de la Révolution, jour des Récompenses") + (1801 9 23 "Primidi 1 Vendémiaire an 10 de la Révolution, jour du Raisin") + (1823 9 22 "Quintidi 5 jour complémentaire an 31 de la Révolution, jour des Récompenses") + (1823 9 23 "Primidi 1 Vendémiaire an 32 de la Révolution, jour du Raisin") + (1824 9 22 "Sextidi 6 jour complémentaire an 32 de la Révolution, jour de la Révolution") + (1824 9 23 "Primidi 1 Vendémiaire an 33 de la Révolution, jour du Raisin") + (1825 9 22 "Quintidi 5 jour complémentaire an 33 de la Révolution, jour des Récompenses") + (1825 9 23 "Primidi 1 Vendémiaire an 34 de la Révolution, jour du Raisin") + (1892 9 21 "Quintidi 5 jour complémentaire an 100 de la Révolution, jour des Récompenses") + (1892 9 22 "Primidi 1 Vendémiaire an 101 de la Révolution, jour du Raisin") + (1900 9 22 "Sextidi 6 jour complémentaire an 108 de la Révolution, jour de la Révolution") + (1900 9 23 "Primidi 1 Vendémiaire an 109 de la Révolution, jour du Raisin") + (1992 9 21 "Quintidi 5 jour complémentaire an 200 de la Révolution, jour des Récompenses") + (1992 9 22 "Primidi 1 Vendémiaire an 201 de la Révolution, jour du Raisin") + (2000 9 21 "Sextidi 6 jour complémentaire an 208 de la Révolution, jour de la Révolution") + (2000 9 22 "Primidi 1 Vendémiaire an 209 de la Révolution, jour du Raisin") + (2092 9 20 "Quintidi 5 jour complémentaire an 300 de la Révolution, jour des Récompenses") + (2092 9 21 "Primidi 1 Vendémiaire an 301 de la Révolution, jour du Raisin") + (2100 9 21 "Sextidi 6 jour complémentaire an 308 de la Révolution, jour de la Révolution") + (2100 9 22 "Primidi 1 Vendémiaire an 309 de la Révolution, jour du Raisin") + (2192 9 21 "Sextidi 6 jour complémentaire an 400 de la Révolution, jour de la Révolution") + (2192 9 22 "Primidi 1 Vendémiaire an 401 de la Révolution, jour du Raisin") + (2193 9 21 "Quintidi 5 jour complémentaire an 401 de la Révolution, jour des Récompenses") + (2199 9 22 "Primidi 1 Vendémiaire an 408 de la Révolution, jour du Raisin") + (2200 9 22 "Sextidi 6 jour complémentaire an 408 de la Révolution, jour de la Révolution") + (2791 9 23 "Primidi 1 Vendémiaire an 1000 de la Révolution, jour du Raisin") + (2792 9 22 "Primidi 1 Vendémiaire an 1001 de la Révolution, jour du Raisin") + (3000 1 1 "Duodi 12 Nivôse an 1208 de la Révolution, jour de l'Argile") + (3001 1 1 "Primidi 11 Nivôse an 1209 de la Révolution, jour du Granit") + (3791 9 22 "Primidi 1 Vendémiaire an 2000 de la Révolution, jour du Raisin") + (3792 9 22 "Primidi 1 Vendémiaire an 2001 de la Révolution, jour du Raisin") + (4000 1 1 "Duodi 12 Nivôse an 2208 de la Révolution, jour de l'Argile") + (4001 1 1 "Duodi 12 Nivôse an 2209 de la Révolution, jour de l'Argile") + (4320 9 10 "Quartidi 24 Fructidor an 2528 de la Révolution, jour du Sorgho") + (4320 9 11 "Quintidi 25 Fructidor an 2528 de la Révolution, jour de l'Écrevisse") + (4791 9 23 "Primidi 1 Vendémiaire an 3000 de la Révolution, jour du Raisin") + (4792 9 22 "Primidi 1 Vendémiaire an 3001 de la Révolution, jour du Raisin") + (5000 1 1 "Duodi 12 Nivôse an 3208 de la Révolution, jour de l'Argile") + (5001 1 1 "Primidi 11 Nivôse an 3209 de la Révolution, jour du Granit") + (5791 9 22 "Primidi 1 Vendémiaire an 4000 de la Révolution, jour du Raisin") + (5792 9 21 "Primidi 1 Vendémiaire an 4001 de la Révolution, jour du Raisin") + (6000 1 1 "Tridi 13 Nivôse an 4208 de la Révolution, jour de l'Ardoise") + (6001 1 1 "Tridi 13 Nivôse an 4209 de la Révolution, jour de l'Ardoise") + (6791 9 22 "Primidi 1 Vendémiaire an 5000 de la Révolution, jour du Raisin") + (6792 9 21 "Primidi 1 Vendémiaire an 5001 de la Révolution, jour du Raisin") + (7791 9 21 "Primidi 1 Vendémiaire an 6000 de la Révolution, jour du Raisin") + (7792 9 21 "Primidi 1 Vendémiaire an 6001 de la Révolution, jour du Raisin") + )) + +(ert-deftest cal-french-tests () + (pcase-dolist (`(,y ,m ,d ,str) cal-french-test-cases) + (should (equal (calendar-french-date-string (list m d y)) str)))) + +(provide 'cal-french-tests) commit aa5437493b1ca539409495ecdc54cf420ea110b9 Author: Mattias Engdegård Date: Sun Jul 18 20:32:49 2021 +0200 Off-by-one error in compilation rule end-column function (bug#49624) * lisp/progmodes/compile.el (compilation-error-properties): When the end-column parameter of a compilation message rule (in compilation-error-regexp-alist[-alist]) is a function, treat its return value as if it were matched by the regexp, which is how it is documented to work, and how all other parameters work. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e4363e11b8..02d1c58858 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1248,11 +1248,14 @@ POS and RES.") (setq col (match-string-no-properties col)) (string-to-number col)))) (setq end-col - (or (if (functionp end-col) (funcall end-col) - (and end-col - (setq end-col (match-string-no-properties end-col)) - (- (string-to-number end-col) -1))) - (and end-line -1))) + (let ((ec (if (functionp end-col) + (funcall end-col) + (and end-col (match-beginning end-col) + (string-to-number + (match-string-no-properties end-col)))))) + (if ec + (1+ ec) ; Add one to get an exclusive upper bound. + (and end-line -1)))) (if (consp type) ; not a static type, check what it is. (setq type (or (and (car type) (match-end (car type)) 1) (and (cdr type) (match-end (cdr type)) 0) diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 0623cec528..2a3bb3dafa 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -515,4 +515,31 @@ The test data is in `compile-tests--grep-regexp-testcases'." (compile--test-error-line testcase)) (should (eq compilation-num-errors-found 8)))) +(ert-deftest compile-test-functions () + "Test rules using functions instead of regexp group numbers." + (let* ((file-fun (lambda () '("my-file"))) + (line-start-fun (lambda () 123)) + (line-end-fun (lambda () 134)) + (col-start-fun (lambda () 39)) + (col-end-fun (lambda () 24)) + (compilation-error-regexp-alist-alist + `((my-rule + ,(rx bol "My error message") + ,file-fun + (,line-start-fun . ,line-end-fun) + (,col-start-fun . ,col-end-fun)))) + (compilation-error-regexp-alist '(my-rule))) + (with-temp-buffer + (font-lock-mode -1) + (let ((compilation-num-errors-found 0) + (compilation-num-warnings-found 0) + (compilation-num-infos-found 0)) + (compile--test-error-line + '(my-rule + "My error message" + 1 (39 . 24) (123 . 134) "my-file" 2)) + (should (eq compilation-num-errors-found 1)) + (should (eq compilation-num-warnings-found 0)) + (should (eq compilation-num-infos-found 0)))))) + ;;; compile-tests.el ends here commit 109ca1bd00b56ba66b123b505d8c2187fded0ef7 Author: Mattias Engdegård Date: Thu Jul 22 15:00:17 2021 +0200 Warn about arity errors in inlining calls (bug#12299) Wrong number of arguments in inlining function calls (to `defsubst` or explicitly using `inline`) did not result in warnings, or in very cryptic ones. * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Add calls to `byte-compile--check-arity-bytecode`. * lisp/emacs-lisp/bytecomp.el (byte-compile-emit-callargs-warn) (byte-compile--check-arity-bytecode): New functions. (byte-compile-callargs-warn): Use factored-out function. * test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el: * test/lisp/emacs-lisp/bytecomp-tests.el ("warn-callargs-defsubst.el"): New test case. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 341643c7d1..ad9f827171 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -274,6 +274,7 @@ Earlier variables shadow later ones with the same name.") ((pred byte-code-function-p) ;; (message "Inlining byte-code for %S!" name) ;; The byte-code will be really inlined in byte-compile-unfold-bcf. + (byte-compile--check-arity-bytecode form fn) `(,fn ,@(cdr form))) ((or `(lambda . ,_) `(closure . ,_)) ;; While byte-compile-unfold-bcf can inline dynbind byte-code into @@ -300,7 +301,9 @@ Earlier variables shadow later ones with the same name.") ;; surrounded the `defsubst'. (byte-compile-warnings nil)) (byte-compile name)) - `(,(symbol-function name) ,@(cdr form)))) + (let ((bc (symbol-function name))) + (byte-compile--check-arity-bytecode form bc) + `(,bc ,@(cdr form))))) (_ ;; Give up on inlining. form)))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2968f1af5d..f6150069e8 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1477,6 +1477,30 @@ when printing the error message." (push (list f byte-compile-last-position nargs) byte-compile-unresolved-functions))))) +(defun byte-compile-emit-callargs-warn (name actual-args min-args max-args) + (byte-compile-set-symbol-position name) + (byte-compile-warn + "%s called with %d argument%s, but %s %s" + name actual-args + (if (= 1 actual-args) "" "s") + (if (< actual-args min-args) + "requires" + "accepts only") + (byte-compile-arglist-signature-string (cons min-args max-args)))) + +(defun byte-compile--check-arity-bytecode (form bytecode) + "Check that the call in FORM matches that allowed by BYTECODE." + (when (and (byte-code-function-p bytecode) + (byte-compile-warning-enabled-p 'callargs)) + (let* ((actual-args (length (cdr form))) + (arity (func-arity bytecode)) + (min-args (car arity)) + (max-args (and (numberp (cdr arity)) (cdr arity)))) + (when (or (< actual-args min-args) + (and max-args (> actual-args max-args))) + (byte-compile-emit-callargs-warn + (car form) actual-args min-args max-args))))) + ;; Warn if the form is calling a function with the wrong number of arguments. (defun byte-compile-callargs-warn (form) (let* ((def (or (byte-compile-fdefinition (car form) nil) @@ -1491,16 +1515,9 @@ when printing the error message." (setcdr sig nil)) (if sig (when (or (< ncall (car sig)) - (and (cdr sig) (> ncall (cdr sig)))) - (byte-compile-set-symbol-position (car form)) - (byte-compile-warn - "%s called with %d argument%s, but %s %s" - (car form) ncall - (if (= 1 ncall) "" "s") - (if (< ncall (car sig)) - "requires" - "accepts only") - (byte-compile-arglist-signature-string sig)))) + (and (cdr sig) (> ncall (cdr sig)))) + (byte-compile-emit-callargs-warn + (car form) ncall (car sig) (cdr sig)))) (byte-compile-format-warn form) (byte-compile-function-warn (car form) (length (cdr form)) def))) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el new file mode 100644 index 0000000000..3a29128cf3 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el @@ -0,0 +1,5 @@ +;;; -*- lexical-binding: t -*- +(defsubst warn-callargs-defsubst-f1 (_x) + nil) +(defun warn-callargs-defsubst-f2 () + (warn-callargs-defsubst-f1 1 2)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 33413f5a00..7c40f7ebca 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -700,6 +700,9 @@ byte-compiled. Run with dynamic binding." (bytecomp--define-warning-file-test "warn-callargs.el" "with 2 arguments, but accepts only 1") +(bytecomp--define-warning-file-test "warn-callargs-defsubst.el" + "with 2 arguments, but accepts only 1") + (bytecomp--define-warning-file-test "warn-defcustom-nogroup.el" "fails to specify containing group") commit 4d172946c3953b3990182d794e5bda6a11646e29 Author: F. Jason Park Date: Fri Jul 23 15:18:05 2021 +0200 Remove text props from callback args in erc-button * lisp/erc/erc-button.el (erc-button-add-buttons-1): Remove text properties from strings stored in `erc-data' and passed to `erc-callback' (both text properties themselves) (bug#49704). This reduces memory usage in erc buffers (which are long-lived and can become very large). diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 4678e7b560..5953471ae8 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -300,7 +300,7 @@ specified by `erc-button-alist'." (end (match-end (nth 1 entry))) (form (nth 2 entry)) (fun (nth 3 entry)) - (data (mapcar #'match-string (nthcdr 4 entry)))) + (data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) (when (or (eq t form) (eval form t)) (erc-button-add-button start end fun nil data regexp))))) commit 172dfac035d471f40d456a559518944ce47b337a Author: Lars Ingebrigtsen Date: Fri Jul 23 15:12:03 2021 +0200 declare-function doc string clarification about FILE * lisp/subr.el (declare-function): Mention that FILE can be nil (bug#21466). diff --git a/lisp/subr.el b/lisp/subr.el index 49c26cc0d3..59a1af01ba 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -31,7 +31,8 @@ "Tell the byte-compiler that function FN is defined, in FILE. The FILE argument is not used by the byte-compiler, but by the `check-declare' package, which checks that FILE contains a -definition for FN. +definition for FN. (FILE can be nil, and that disables this +check.) FILE can be either a Lisp file (in which case the \".el\" extension is optional), or a C file. C files are expanded commit 99018681c40f5854dd8fad8e226b6dc1609cafe2 Author: Stefan Kangas Date: Fri Jul 23 14:57:44 2021 +0200 Make nil value of fill-column obsolete * lisp/textmodes/fill.el (current-fill-column): Make nil value of 'fill-column' obsolete. (Bug#22847) (current-fill-column--has-warned): New variable to track warning. * lisp/simple.el (do-auto-fill): Remove handling of nil return value from 'current-fill-column'. * etc/NEWS: Announce obsoletion of this usage. diff --git a/etc/NEWS b/etc/NEWS index 4987e5c07d..29953a8fa2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -118,6 +118,16 @@ avoid security issues when executing untrusted code. See the manual page for 'seccomp' system call, for details about Secure Computing filters. +** Setting 'fill-column' to nil is obsolete. +This undocumented use of 'fill-column' is now obsolete. If you have +set this value to nil disable auto filling, instead disable +'auto-fill-mode' in the relevant mode instead. + +For instance, you could add something like the following to your init +file: + + (add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1)) + * Changes in Emacs 28.1 diff --git a/lisp/simple.el b/lisp/simple.el index 1a49fe2425..ee2698dc67 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8057,7 +8057,7 @@ Returns t if it really did any work." (let (fc justify give-up (fill-prefix fill-prefix)) (if (or (not (setq justify (current-justification))) - (null (setq fc (current-fill-column))) + (setq fc (current-fill-column)) (and (eq justify 'left) (<= (current-column) fc)) (and auto-fill-inhibit-regexp diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 3914bdeb83..f394171fb6 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -133,6 +133,8 @@ A nil return value means the function has not determined the fill prefix." (defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks. "Whether or not filling should try to use the major mode's indentation.") +(defvar current-fill-column--has-warned nil) + (defun current-fill-column () "Return the fill-column to use for this line. The fill-column to use for a buffer is stored in the variable `fill-column', @@ -158,7 +160,14 @@ number equals or exceeds the local fill-column - right-margin difference." (< col fill-col))) (setq here change here-col col)) - (max here-col fill-col))))) + (max here-col fill-col)) + ;; This warning was added in 28.1. It should be removed later, + ;; and this function changed to never return nil. + (unless current-fill-column--has-warned + (lwarn '(fill-column) :warning + "Setting this variable to nil is obsolete; use `(auto-fill-mode -1)' instead") + (setq current-fill-column--has-warned t)) + most-positive-fixnum))) (defun canonically-space-region (beg end) "Remove extra spaces between words in region. commit 4357d595ee69343856917041c48e8c004da922d1 Author: Lars Ingebrigtsen Date: Fri Jul 23 14:46:12 2021 +0200 Adjust time-tests.el to bug#30056 * test/lisp/time-tests.el (time-tests-display-time-update): Adjust test (bug#30056). diff --git a/test/lisp/time-tests.el b/test/lisp/time-tests.el index 3cf8b540cb..88b7638d91 100644 --- a/test/lisp/time-tests.el +++ b/test/lisp/time-tests.el @@ -50,6 +50,7 @@ (? (| "AM" "PM")) " " (+ (| digit ".")) (? " Mail") + " " string-end) display-time-string)))) commit 9dfa94aed10a186eae2ddd8fab0ba0cb56996431 Author: Lars Ingebrigtsen Date: Fri Jul 23 14:44:15 2021 +0200 Move mode-line NEWS items to a common section diff --git a/etc/NEWS b/etc/NEWS index 759f7cabaa..4987e5c07d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3327,6 +3327,27 @@ file mode specification into symbolic form. ** The variable 'force-new-style-backquotes' has been removed. This removes the final remaining trace of old-style backquotes. +** Mode Lines + ++++ +*** New user options to control the line/column numbers in the mode line. +'mode-line-position-line-format' is the line number format (when +'line-number-mode' is on), 'mode-line-position-column-format' is +the column number format (when 'column-number-mode' is on), and +'mode-line-position-column-line-format' is the combined format (when +both modes are on). + ++++ +*** New user option 'mode-line-compact'. +If non-nil, repeating spaces are compressed into a single space. If +'long', this is only done when the mode line is longer than the +current window width (in characters). + ++++ +*** 'global-mode-string' constructs should end with a space. +This was previously not formalized, which led to combinations of modes +displaying data "smushed together" on the mode line. + ** Changes in handling dynamic modules *** The module header 'emacs-module.h' now contains type aliases commit bb68faed02d6c0eef48923b4ef4e4eda5e6486ba Author: Lars Ingebrigtsen Date: Fri Jul 23 14:40:53 2021 +0200 'global-mode-string' elements should have a space at the end * lisp/time.el (display-time-string-forms): * lisp/battery.el (battery-mode-line-format): Add a space to the end (bug#30056). * lisp/bindings.el (mode-line-misc-info): Remove space from end. This will make the default format have one space before the line-of-dashes (instead of two) on terminals. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 7214948850..b0dc0ff916 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2287,11 +2287,14 @@ enabled separately in each buffer. @defvar global-mode-string This variable holds a mode line construct that, by default, appears in -the mode line just after the @code{which-function-mode} minor mode if set, -else after @code{mode-line-modes}. The command @code{display-time} sets +the mode line just after the @code{which-function-mode} minor mode if +set, else after @code{mode-line-modes}. Elements that are added to +this construct should normally end in a space (to ensure that +consecutive @code{global-mode-string} elements display properly). For +instance, the command @code{display-time} sets @code{global-mode-string} to refer to the variable -@code{display-time-string}, which holds a string containing the time and -load information. +@code{display-time-string}, which holds a string containing the time +and load information. The @samp{%M} construct substitutes the value of @code{global-mode-string}, but that is obsolete, since the variable is diff --git a/etc/NEWS b/etc/NEWS index 95218faa1b..759f7cabaa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2505,6 +2505,11 @@ If non-nil, repeating spaces are compressed into a single space. If 'long', this is only done when the mode line is longer than the current window width (in characters). ++++ +*** 'global-mode-string' constructs should end with a space. +This was previously not formalized, which led to combinations of modes +displaying data "smushed together" on the mode line. + +++ *** New command 'submit-emacs-patch'. This works like 'report-emacs-bug', but is more geared towards sending diff --git a/lisp/battery.el b/lisp/battery.el index 59f6987ad1..bf864c2bd4 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -161,9 +161,9 @@ The full `format-spec' formatting syntax is supported." (defcustom battery-mode-line-format (cond ((eq battery-status-function #'battery-linux-proc-acpi) - "[%b%p%%,%d°C]") + "[%b%p%%,%d°C] ") (battery-status-function - "[%b%p%%]")) + "[%b%p%%] ")) "Control string formatting the string to display in the mode line. Ordinary characters in the control string are printed as-is, while conversion specifications introduced by a `%' character in the control diff --git a/lisp/bindings.el b/lisp/bindings.el index 06ba5d06e7..4b194c0c01 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -580,7 +580,7 @@ Major modes that edit things other than ordinary files may change this (put 'mode-line-buffer-identification 'risky-local-variable t) (defvar mode-line-misc-info - '((global-mode-string ("" global-mode-string " "))) + '((global-mode-string ("" global-mode-string))) "Mode line construct for miscellaneous information. By default, this shows the information specified by `global-mode-string'.") (put 'mode-line-misc-info 'risky-local-variable t) diff --git a/lisp/time.el b/lisp/time.el index fd53f634c6..9f25f99a14 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -205,7 +205,8 @@ depend on `display-time-day-and-date' and `display-time-24hr-format'." 'mouse-face 'mode-line-highlight 'local-map (make-mode-line-mouse-map 'mouse-2 read-mail-command))) - "")) + "") + " ") "List of expressions governing display of the time in the mode line. For most purposes, you can control the time format using `display-time-format' which is a more standard interface. commit f3806ee149c698e2a87258c5ecdea8bc8aa88664 Author: Lars Ingebrigtsen Date: Fri Jul 23 14:13:38 2021 +0200 Fix an rcirc merge problem * lisp/net/rcirc.el (rcirc-get-server-method) (rcirc-get-server-password): Remove double definition after merge. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 79653728e5..f11f36e809 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -631,22 +631,6 @@ See `rcirc-connect' for more details on these variables.") (when (string-match server-i server) (throw 'pass (car args))))))) -(defun rcirc-get-server-method (server) - (catch 'method - (dolist (i rcirc-authinfo) - (let ((server-i (car i)) - (method (cadr i))) - (when (string-match server-i server) - (throw 'method method)))))) - -(defun rcirc-get-server-password (server) - (catch 'pass - (dolist (i rcirc-authinfo) - (let ((server-i (car i)) - (args (cdddr i))) - (when (string-match server-i server) - (throw 'pass (car args))))))) - ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption commit ce04a88f3c0e0548eacff03018d7d7bdd88ec517 Author: Eli Zaretskii Date: Fri Jul 23 14:56:16 2021 +0300 MS-Windows followup to recent emacsclient changes * nt/gnulib-cfg.mk (OMIT_GNULIB_MODULE_file-has-acl): Set to true to avoid compiling file-has-acl.c on MS-Windows. diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index 5cdbde6bb5..c85b9150f0 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk @@ -68,3 +68,4 @@ OMIT_GNULIB_MODULE_fchmodat = true OMIT_GNULIB_MODULE_lchmod = true OMIT_GNULIB_MODULE_futimens = true OMIT_GNULIB_MODULE_utimensat = true +OMIT_GNULIB_MODULE_file-has-acl = true commit 007744dd0404d6febca88b00c22981cc630fb8c0 Author: Paul Eggert Date: Fri Jul 23 13:33:21 2021 +0200 Redo emacsclient socket symlink-attack checking * admin/merge-gnulib (GNULIB_MODULES): Add file-has-acl. * lib/file-has-acl.c: New file, copied from Gnulib. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lib-src/emacsclient.c: Include acl.h, for file_has_acl. (O_PATH): Default to O_SEARCH, which is good enough here. (union local_sockaddr): New type. (socket_status): Remove, replacing with ... (connect_socket): New function. All callers changed. This function checks for ownership and permissions issues with the parent directory of the socket file, instead of checking the owner of the socket (which does not help security). (socknamesize): Move to file scope. (local_sockname): New arg S. No need to pass socknamesize. UID arg is now uid_t. All callers changed. Get file descriptor of parent directory of socket, to foil some symlink attacks. Do not follow symlinks to that directory. (set_local_socket): Create the socket here instead of on each attempt to connect it. Fall back from XDG_RUNTIME_DIR to /tmp only if the former fails due to ENOENT. Adjust permission-failure diagnostic to match changed behavior. This addresses Bug#33847, which complained about emacsclient in a safer XDG environment not connecting to an Emacs server running in a less-safe enviroment outside XDG. The patch fixes a longstanding issue with emacsclient permission checking. It’s ineffective to look at the permission of the socket file itself; on some platforms, these permissions are ignored anyway. What matters are the permissions on the parent directory of the socket file, as these are what make symlink attacks possible. Change the permissions check accordingly, and also refuse to follow symlinks to that parent directory. These changes make it OK for emacsclient to fall back from XDG_RUNTIME_DIR to the traditionally less-safe /tmp/emacsNNNN directories, since /tmp is universally sticky nowadays. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 1c8b442700..c12e83dd2f 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -33,7 +33,7 @@ GNULIB_MODULES=' crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer d-type diffseq double-slash-root dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat - fchmodat fcntl fcntl-h fdopendir + fchmodat fcntl fcntl-h fdopendir file-has-acl filemode filename filevercmp flexmember fpieee free-posix fstatat fsusage fsync futimens getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 12ced4aadb..8346524a3e 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -80,6 +80,9 @@ char *w32_getenv (const char *); #include #include +#ifndef WINDOWSNT +# include +#endif #include #include #include @@ -91,6 +94,10 @@ char *w32_getenv (const char *); # pragma GCC diagnostic ignored "-Wformat-truncation=2" #endif +#if !defined O_PATH && !defined WINDOWSNT +# define O_PATH O_SEARCH +#endif + /* Name used to invoke this program. */ static char const *progname; @@ -1128,24 +1135,74 @@ process_grouping (void) #ifdef SOCKETS_IN_FILE_SYSTEM -/* Return the file status of NAME, ordinarily a socket. - It should be owned by UID. Return one of the following: - >0 - 'stat' failed with this errno value - -1 - isn't owned by us - 0 - success: none of the above */ +/* A local socket address. The union avoids the need to cast. */ +union local_sockaddr +{ + struct sockaddr_un un; + struct sockaddr sa; +}; + +/* Relative to the directory DIRFD, connect the socket file named ADDR + to the socket S. Return 0 if successful, -1 if DIRFD is not + AT_FDCWD and DIRFD's permissions would allow a symlink attack, an + errno otherwise. */ static int -socket_status (const char *name, uid_t uid) +connect_socket (int dirfd, char const *addr, int s, uid_t uid) { - struct stat statbfr; + int sock_status = 0; - if (stat (name, &statbfr) != 0) - return errno; + union local_sockaddr server; + if (sizeof server.un.sun_path <= strlen (addr)) + return ENAMETOOLONG; + server.un.sun_family = AF_UNIX; + strcpy (server.un.sun_path, addr); - if (statbfr.st_uid != uid) - return -1; + /* If -1, WDFD is not set yet. If nonnegative, WDFD is a file + descriptor for the initial working directory. Otherwise -1 - WDFD is + the error number for the initial working directory. */ + static int wdfd = -1; - return 0; + if (dirfd != AT_FDCWD) + { + /* Fail if DIRFD's permissions are bogus. */ + struct stat st; + if (fstat (dirfd, &st) != 0) + return errno; + if (st.st_uid != uid || (st.st_mode & (S_IWGRP | S_IWOTH))) + return -1; + + if (wdfd == -1) + { + /* Save the initial working directory. */ + wdfd = open (".", O_PATH | O_CLOEXEC); + if (wdfd < 0) + wdfd = -1 - errno; + } + if (wdfd < 0) + return -1 - wdfd; + if (fchdir (dirfd) != 0) + return errno; + + /* Fail if DIRFD has an ACL, which means its permissions are + almost surely bogus. */ + int has_acl = file_has_acl (".", &st); + if (has_acl) + sock_status = has_acl < 0 ? errno : -1; + } + + if (!sock_status) + sock_status = connect (s, &server.sa, sizeof server.un) == 0 ? 0 : errno; + + /* Fail immediately if we cannot change back to the initial working + directory, as that can mess up the rest of execution. */ + if (dirfd != AT_FDCWD && fchdir (wdfd) != 0) + { + message (true, "%s: .: %s\n", progname, strerror (errno)); + exit (EXIT_FAILURE); + } + + return sock_status; } @@ -1322,32 +1379,49 @@ act_on_signals (HSOCKET emacs_socket) } } -/* Create in SOCKNAME (of size SOCKNAMESIZE) a name for a local socket. - The first TMPDIRLEN bytes of SOCKNAME are already initialized to be - the name of a temporary directory. Use UID and SERVER_NAME to - concoct the name. Return the total length of the name if successful, - -1 if it does not fit (and store a truncated name in that case). - Fail if TMPDIRLEN is out of range. */ +enum { socknamesize = sizeof ((struct sockaddr_un *) NULL)->sun_path }; + +/* Given a local socket S, create in *SOCKNAME a name for a local socket + and connect to that socket. The first TMPDIRLEN bytes of *SOCKNAME are + already initialized to be the name of a temporary directory. + Use UID and SERVER_NAME to concoct the name. Return 0 if + successful, -1 if the socket's parent directory is not safe, and an + errno if there is some other problem. */ static int -local_sockname (char *sockname, int socknamesize, int tmpdirlen, - uintmax_t uid, char const *server_name) +local_sockname (int s, char sockname[socknamesize], int tmpdirlen, + uid_t uid, char const *server_name) { /* If ! (0 <= TMPDIRLEN && TMPDIRLEN < SOCKNAMESIZE) the truncated temporary directory name is already in SOCKNAME, so nothing more need be stored. */ - if (0 <= tmpdirlen) - { - int remaining = socknamesize - tmpdirlen; - if (0 < remaining) - { - int suffixlen = snprintf (&sockname[tmpdirlen], remaining, - "/emacs%"PRIuMAX"/%s", uid, server_name); - if (0 <= suffixlen && suffixlen < remaining) - return tmpdirlen + suffixlen; - } - } - return -1; + if (! (0 <= tmpdirlen && tmpdirlen < socknamesize)) + return ENAMETOOLONG; + + /* Put the full address name into the buffer, since the caller might + need it for diagnostics. But don't overrun the buffer. */ + uintmax_t uidmax = uid; + int emacsdirlen; + int suffixlen = snprintf (sockname + tmpdirlen, socknamesize - tmpdirlen, + "/emacs%"PRIuMAX"%n/%s", uidmax, &emacsdirlen, + server_name); + if (! (0 <= suffixlen && suffixlen < socknamesize - tmpdirlen)) + return ENAMETOOLONG; + + /* Make sure the address's parent directory is not a symlink and is + this user's directory and does not let others write to it; this + fends off some symlink attacks. To avoid races, keep the parent + directory open while checking. */ + char *emacsdirend = sockname + tmpdirlen + emacsdirlen; + *emacsdirend = '\0'; + int dir = openat (AT_FDCWD, sockname, + O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC); + *emacsdirend = '/'; + if (dir < 0) + return errno; + int sock_status = connect_socket (dir, server_name, s, uid); + close (dir); + return sock_status; } /* Create a local socket for SERVER_NAME and connect it to Emacs. If @@ -1358,28 +1432,43 @@ local_sockname (char *sockname, int socknamesize, int tmpdirlen, static HSOCKET set_local_socket (char const *server_name) { - union { - struct sockaddr_un un; - struct sockaddr sa; - } server = {{ .sun_family = AF_UNIX }}; + union local_sockaddr server; + int sock_status; char *sockname = server.un.sun_path; - enum { socknamesize = sizeof server.un.sun_path }; int tmpdirlen = -1; int socknamelen = -1; uid_t uid = geteuid (); bool tmpdir_used = false; + int s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0); + if (s < 0) + { + message (true, "%s: can't create socket: %s\n", + progname, strerror (errno)); + fail (); + } if (strchr (server_name, '/') || (ISSLASH ('\\') && strchr (server_name, '\\'))) - socknamelen = snprintf (sockname, socknamesize, "%s", server_name); + { + socknamelen = snprintf (sockname, socknamesize, "%s", server_name); + sock_status = (0 <= socknamelen && socknamelen < socknamesize + ? connect_socket (AT_FDCWD, sockname, s, 0) + : ENAMETOOLONG); + } else { /* socket_name is a file name component. */ + sock_status = ENOENT; char const *xdg_runtime_dir = egetenv ("XDG_RUNTIME_DIR"); if (xdg_runtime_dir) - socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s", - xdg_runtime_dir, server_name); - else + { + socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s", + xdg_runtime_dir, server_name); + sock_status = (0 <= socknamelen && socknamelen < socknamesize + ? connect_socket (AT_FDCWD, sockname, s, 0) + : ENAMETOOLONG); + } + if (sock_status == ENOENT) { char const *tmpdir = egetenv ("TMPDIR"); if (tmpdir) @@ -1398,23 +1487,24 @@ set_local_socket (char const *server_name) if (tmpdirlen < 0) tmpdirlen = snprintf (sockname, socknamesize, "/tmp"); } - socknamelen = local_sockname (sockname, socknamesize, tmpdirlen, + sock_status = local_sockname (s, sockname, tmpdirlen, uid, server_name); tmpdir_used = true; } } - if (! (0 <= socknamelen && socknamelen < socknamesize)) + if (sock_status == 0) + return s; + + if (sock_status == ENAMETOOLONG) { message (true, "%s: socket-name %s... too long\n", progname, sockname); fail (); } - /* See if the socket exists, and if it's owned by us. */ - int sock_status = socket_status (sockname, uid); - if (sock_status) + if (tmpdir_used) { - /* Failing that, see if LOGNAME or USER exist and differ from + /* See whether LOGNAME or USER exist and differ from our euid. If so, look for a socket based on the UID associated with the name. This is reminiscent of the logic that init_editfns uses to set the global Vuser_full_name. */ @@ -1431,48 +1521,26 @@ set_local_socket (char const *server_name) if (pw && pw->pw_uid != uid) { /* We're running under su, apparently. */ - socknamelen = local_sockname (sockname, socknamesize, tmpdirlen, + sock_status = local_sockname (s, sockname, tmpdirlen, pw->pw_uid, server_name); - if (socknamelen < 0) + if (sock_status == 0) + return s; + if (sock_status == ENAMETOOLONG) { message (true, "%s: socket-name %s... too long\n", progname, sockname); exit (EXIT_FAILURE); } - - sock_status = socket_status (sockname, uid); } } } - if (sock_status == 0) - { - HSOCKET s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0); - if (s < 0) - { - message (true, "%s: socket: %s\n", progname, strerror (errno)); - return INVALID_SOCKET; - } - if (connect (s, &server.sa, sizeof server.un) != 0) - { - message (true, "%s: connect: %s\n", progname, strerror (errno)); - CLOSE_SOCKET (s); - return INVALID_SOCKET; - } + close (s); - struct stat connect_stat; - if (fstat (s, &connect_stat) != 0) - sock_status = errno; - else if (connect_stat.st_uid == uid) - return s; - else - sock_status = -1; - - CLOSE_SOCKET (s); - } - - if (sock_status < 0) - message (true, "%s: Invalid socket owner\n", progname); + if (sock_status == -1) + message (true, + "%s: Invalid permissions on parent directory of socket: %s\n", + progname, sockname); else if (sock_status == ENOENT) { if (tmpdir_used) @@ -1502,7 +1570,7 @@ set_local_socket (char const *server_name) } } else - message (true, "%s: can't stat %s: %s\n", + message (true, "%s: can't connect to %s: %s\n", progname, sockname, strerror (sock_status)); return INVALID_SOCKET; diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c new file mode 100644 index 0000000000..c667ae9d24 --- /dev/null +++ b/lib/file-has-acl.c @@ -0,0 +1,510 @@ +/* Test whether a file has a nontrivial ACL. -*- coding: utf-8 -*- + + Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + + Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */ + +/* Without this pragma, gcc 4.7.0 20120126 may suggest that the + file_has_acl function might be candidate for attribute 'const' */ +#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__ +# pragma GCC diagnostic ignored "-Wsuggest-attribute=const" +#endif + +#include + +#include "acl.h" + +#include "acl-internal.h" + +#if GETXATTR_WITH_POSIX_ACLS +# include +# include +#endif + +/* Return 1 if NAME has a nontrivial access control list, + 0 if ACLs are not supported, or if NAME has no or only a base ACL, + and -1 (setting errno) on error. Note callers can determine + if ACLs are not supported as errno is set in that case also. + SB must be set to the stat buffer of NAME, + obtained through stat() or lstat(). */ + +int +file_has_acl (char const *name, struct stat const *sb) +{ +#if USE_ACL + if (! S_ISLNK (sb->st_mode)) + { + +# if GETXATTR_WITH_POSIX_ACLS + + ssize_t ret; + + ret = getxattr (name, XATTR_NAME_POSIX_ACL_ACCESS, NULL, 0); + if (ret < 0 && errno == ENODATA) + ret = 0; + else if (ret > 0) + return 1; + + if (ret == 0 && S_ISDIR (sb->st_mode)) + { + ret = getxattr (name, XATTR_NAME_POSIX_ACL_DEFAULT, NULL, 0); + if (ret < 0 && errno == ENODATA) + ret = 0; + else if (ret > 0) + return 1; + } + + if (ret < 0) + return - acl_errno_valid (errno); + return ret; + +# elif HAVE_ACL_GET_FILE + + /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ + /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ + int ret; + + if (HAVE_ACL_EXTENDED_FILE) /* Linux */ + { + /* On Linux, acl_extended_file is an optimized function: It only + makes two calls to getxattr(), one for ACL_TYPE_ACCESS, one for + ACL_TYPE_DEFAULT. */ + ret = acl_extended_file (name); + } + else /* FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ + { +# if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ + /* On Mac OS X, acl_get_file (name, ACL_TYPE_ACCESS) + and acl_get_file (name, ACL_TYPE_DEFAULT) + always return NULL / EINVAL. There is no point in making + these two useless calls. The real ACL is retrieved through + acl_get_file (name, ACL_TYPE_EXTENDED). */ + acl_t acl = acl_get_file (name, ACL_TYPE_EXTENDED); + if (acl) + { + ret = acl_extended_nontrivial (acl); + acl_free (acl); + } + else + ret = -1; +# else /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ + acl_t acl = acl_get_file (name, ACL_TYPE_ACCESS); + if (acl) + { + int saved_errno; + + ret = acl_access_nontrivial (acl); + saved_errno = errno; + acl_free (acl); + errno = saved_errno; +# if HAVE_ACL_FREE_TEXT /* Tru64 */ + /* On OSF/1, acl_get_file (name, ACL_TYPE_DEFAULT) always + returns NULL with errno not set. There is no point in + making this call. */ +# else /* FreeBSD, IRIX, Cygwin >= 2.5 */ + /* On Linux, FreeBSD, IRIX, acl_get_file (name, ACL_TYPE_ACCESS) + and acl_get_file (name, ACL_TYPE_DEFAULT) on a directory + either both succeed or both fail; it depends on the + file system. Therefore there is no point in making the second + call if the first one already failed. */ + if (ret == 0 && S_ISDIR (sb->st_mode)) + { + acl = acl_get_file (name, ACL_TYPE_DEFAULT); + if (acl) + { +# ifdef __CYGWIN__ /* Cygwin >= 2.5 */ + ret = acl_access_nontrivial (acl); + saved_errno = errno; + acl_free (acl); + errno = saved_errno; +# else + ret = (0 < acl_entries (acl)); + acl_free (acl); +# endif + } + else + ret = -1; + } +# endif + } + else + ret = -1; +# endif + } + if (ret < 0) + return - acl_errno_valid (errno); + return ret; + +# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */ + +# if defined ACL_NO_TRIVIAL + + /* Solaris 10 (newer version), which has additional API declared in + (acl_t) and implemented in libsec (acl_set, acl_trivial, + acl_fromtext, ...). */ + return acl_trivial (name); + +# else /* Solaris, Cygwin, general case */ + + /* Solaris 2.5 through Solaris 10, Cygwin, and contemporaneous versions + of Unixware. The acl() call returns the access and default ACL both + at once. */ + { + /* Initially, try to read the entries into a stack-allocated buffer. + Use malloc if it does not fit. */ + enum + { + alloc_init = 4000 / sizeof (aclent_t), /* >= 3 */ + alloc_max = MIN (INT_MAX, SIZE_MAX / sizeof (aclent_t)) + }; + aclent_t buf[alloc_init]; + size_t alloc = alloc_init; + aclent_t *entries = buf; + aclent_t *malloced = NULL; + int count; + + for (;;) + { + count = acl (name, GETACL, alloc, entries); + if (count < 0 && errno == ENOSPC) + { + /* Increase the size of the buffer. */ + free (malloced); + if (alloc > alloc_max / 2) + { + errno = ENOMEM; + return -1; + } + alloc = 2 * alloc; /* <= alloc_max */ + entries = malloced = + (aclent_t *) malloc (alloc * sizeof (aclent_t)); + if (entries == NULL) + { + errno = ENOMEM; + return -1; + } + continue; + } + break; + } + if (count < 0) + { + if (errno == ENOSYS || errno == ENOTSUP) + ; + else + { + int saved_errno = errno; + free (malloced); + errno = saved_errno; + return -1; + } + } + else if (count == 0) + ; + else + { + /* Don't use MIN_ACL_ENTRIES: It's set to 4 on Cygwin, but Cygwin + returns only 3 entries for files with no ACL. But this is safe: + If there are more than 4 entries, there cannot be only the + "user::", "group::", "other:", and "mask:" entries. */ + if (count > 4) + { + free (malloced); + return 1; + } + + if (acl_nontrivial (count, entries)) + { + free (malloced); + return 1; + } + } + free (malloced); + } + +# ifdef ACE_GETACL + /* Solaris also has a different variant of ACLs, used in ZFS and NFSv4 + file systems (whereas the other ones are used in UFS file systems). */ + { + /* Initially, try to read the entries into a stack-allocated buffer. + Use malloc if it does not fit. */ + enum + { + alloc_init = 4000 / sizeof (ace_t), /* >= 3 */ + alloc_max = MIN (INT_MAX, SIZE_MAX / sizeof (ace_t)) + }; + ace_t buf[alloc_init]; + size_t alloc = alloc_init; + ace_t *entries = buf; + ace_t *malloced = NULL; + int count; + + for (;;) + { + count = acl (name, ACE_GETACL, alloc, entries); + if (count < 0 && errno == ENOSPC) + { + /* Increase the size of the buffer. */ + free (malloced); + if (alloc > alloc_max / 2) + { + errno = ENOMEM; + return -1; + } + alloc = 2 * alloc; /* <= alloc_max */ + entries = malloced = (ace_t *) malloc (alloc * sizeof (ace_t)); + if (entries == NULL) + { + errno = ENOMEM; + return -1; + } + continue; + } + break; + } + if (count < 0) + { + if (errno == ENOSYS || errno == EINVAL) + ; + else + { + int saved_errno = errno; + free (malloced); + errno = saved_errno; + return -1; + } + } + else if (count == 0) + ; + else + { + /* In the old (original Solaris 10) convention: + If there are more than 3 entries, there cannot be only the + ACE_OWNER, ACE_GROUP, ACE_OTHER entries. + In the newer Solaris 10 and Solaris 11 convention: + If there are more than 6 entries, there cannot be only the + ACE_OWNER, ACE_GROUP, ACE_EVERYONE entries, each once with + NEW_ACE_ACCESS_ALLOWED_ACE_TYPE and once with + NEW_ACE_ACCESS_DENIED_ACE_TYPE. */ + if (count > 6) + { + free (malloced); + return 1; + } + + if (acl_ace_nontrivial (count, entries)) + { + free (malloced); + return 1; + } + } + free (malloced); + } +# endif + + return 0; +# endif + +# elif HAVE_GETACL /* HP-UX */ + + { + struct acl_entry entries[NACLENTRIES]; + int count; + + count = getacl (name, NACLENTRIES, entries); + + if (count < 0) + { + /* ENOSYS is seen on newer HP-UX versions. + EOPNOTSUPP is typically seen on NFS mounts. + ENOTSUP was seen on Quantum StorNext file systems (cvfs). */ + if (errno == ENOSYS || errno == EOPNOTSUPP || errno == ENOTSUP) + ; + else + return -1; + } + else if (count == 0) + return 0; + else /* count > 0 */ + { + if (count > NACLENTRIES) + /* If NACLENTRIES cannot be trusted, use dynamic memory + allocation. */ + abort (); + + /* If there are more than 3 entries, there cannot be only the + (uid,%), (%,gid), (%,%) entries. */ + if (count > 3) + return 1; + + { + struct stat statbuf; + + if (stat (name, &statbuf) < 0) + return -1; + + return acl_nontrivial (count, entries); + } + } + } + +# if HAVE_ACLV_H /* HP-UX >= 11.11 */ + + { + struct acl entries[NACLVENTRIES]; + int count; + + count = acl ((char *) name, ACL_GET, NACLVENTRIES, entries); + + if (count < 0) + { + /* EOPNOTSUPP is seen on NFS in HP-UX 11.11, 11.23. + EINVAL is seen on NFS in HP-UX 11.31. */ + if (errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL) + ; + else + return -1; + } + else if (count == 0) + return 0; + else /* count > 0 */ + { + if (count > NACLVENTRIES) + /* If NACLVENTRIES cannot be trusted, use dynamic memory + allocation. */ + abort (); + + /* If there are more than 4 entries, there cannot be only the + four base ACL entries. */ + if (count > 4) + return 1; + + return aclv_nontrivial (count, entries); + } + } + +# endif + +# elif HAVE_ACLX_GET && defined ACL_AIX_WIP /* AIX */ + + acl_type_t type; + char aclbuf[1024]; + void *acl = aclbuf; + size_t aclsize = sizeof (aclbuf); + mode_t mode; + + for (;;) + { + /* The docs say that type being 0 is equivalent to ACL_ANY, but it + is not true, in AIX 5.3. */ + type.u64 = ACL_ANY; + if (aclx_get (name, 0, &type, aclbuf, &aclsize, &mode) >= 0) + break; + if (errno == ENOSYS) + return 0; + if (errno != ENOSPC) + { + if (acl != aclbuf) + { + int saved_errno = errno; + free (acl); + errno = saved_errno; + } + return -1; + } + aclsize = 2 * aclsize; + if (acl != aclbuf) + free (acl); + acl = malloc (aclsize); + if (acl == NULL) + { + errno = ENOMEM; + return -1; + } + } + + if (type.u64 == ACL_AIXC) + { + int result = acl_nontrivial ((struct acl *) acl); + if (acl != aclbuf) + free (acl); + return result; + } + else if (type.u64 == ACL_NFS4) + { + int result = acl_nfs4_nontrivial ((nfs4_acl_int_t *) acl); + if (acl != aclbuf) + free (acl); + return result; + } + else + { + /* A newer type of ACL has been introduced in the system. + We should better support it. */ + if (acl != aclbuf) + free (acl); + errno = EINVAL; + return -1; + } + +# elif HAVE_STATACL /* older AIX */ + + union { struct acl a; char room[4096]; } u; + + if (statacl ((char *) name, STX_NORMAL, &u.a, sizeof (u)) < 0) + return -1; + + return acl_nontrivial (&u.a); + +# elif HAVE_ACLSORT /* NonStop Kernel */ + + { + struct acl entries[NACLENTRIES]; + int count; + + count = acl ((char *) name, ACL_GET, NACLENTRIES, entries); + + if (count < 0) + { + if (errno == ENOSYS || errno == ENOTSUP) + ; + else + return -1; + } + else if (count == 0) + return 0; + else /* count > 0 */ + { + if (count > NACLENTRIES) + /* If NACLENTRIES cannot be trusted, use dynamic memory + allocation. */ + abort (); + + /* If there are more than 4 entries, there cannot be only the + four base ACL entries. */ + if (count > 4) + return 1; + + return acl_nontrivial (count, entries); + } + } + +# endif + } +#endif + + return 0; +} diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 07736f9b8b..0b9aaf6d9e 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -98,6 +98,7 @@ # fcntl \ # fcntl-h \ # fdopendir \ +# file-has-acl \ # filemode \ # filename \ # filevercmp \ @@ -1788,6 +1789,16 @@ EXTRA_libgnu_a_SOURCES += fdopendir.c endif ## end gnulib module fdopendir +## begin gnulib module file-has-acl +ifeq (,$(OMIT_GNULIB_MODULE_file-has-acl)) + +libgnu_a_SOURCES += file-has-acl.c + +EXTRA_DIST += acl-internal.h + +endif +## end gnulib module file-has-acl + ## begin gnulib module filemode ifeq (,$(OMIT_GNULIB_MODULE_filemode)) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index cd6f7b4bbd..05e7faa993 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -89,6 +89,7 @@ AC_DEFUN([gl_EARLY], # Code from module fcntl: # Code from module fcntl-h: # Code from module fdopendir: + # Code from module file-has-acl: # Code from module filemode: # Code from module filename: # Code from module filevercmp: @@ -287,6 +288,7 @@ AC_DEFUN([gl_INIT], fi gl_DIRENT_MODULE_INDICATOR([fdopendir]) gl_MODULE_INDICATOR([fdopendir]) + gl_FILE_HAS_ACL gl_FILEMODE AC_C_FLEXIBLE_ARRAY_MEMBER gl_FUNC_FPENDING @@ -1045,6 +1047,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/fcntl.c lib/fcntl.in.h lib/fdopendir.c + lib/file-has-acl.c lib/filemode.c lib/filemode.h lib/filename.h commit 55a19a1da26d35673c8eb2c52171ff3b31594dd9 Merge: f1101fdc82 77631c2a77 Author: Philip Kaludercic Date: Fri Jul 23 13:23:35 2021 +0200 Merge branch 'feature/rcirc-update' commit f1101fdc8270d26acb80e522245b0991847e2633 Author: Lars Ingebrigtsen Date: Fri Jul 23 13:15:32 2021 +0200 Make erc recognize `foo*' as a function Lisp symbol * lisp/erc/erc-button.el (erc-button-alist): Add some more chars to the `foo' button regexp (bug#49690). diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index cb9af92ba1..4678e7b560 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -130,7 +130,8 @@ longer than `erc-fill-column'." (" ]+\\) *>" 0 t browse-url-button-open-url 1) ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3) ;; emacs internal - ("[`]\\([a-zA-Z][-a-zA-Z_0-9]+\\)[']" 1 t erc-button-describe-symbol 1) + ("[`]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)[']" + 1 t erc-button-describe-symbol 1) ;; pseudo links ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1) ("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)" commit d3163a3b8fa455a7a0d5b6122c0fc9f3f9a59fbd Author: Lars Ingebrigtsen Date: Fri Jul 23 11:49:13 2021 +0200 Make supersession warnings work again * src/filelock.c (lock_file): Fix thinko in lock_file in 2ad34bcea4e (bug#49701). diff --git a/src/filelock.c b/src/filelock.c index 106633f584..cc185d96cd 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -673,7 +673,7 @@ lock_file (Lisp_Object fn) Lisp_Object subject_buf = get_truename_buffer (fn); if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) - && !NILP (Ffile_exists_p (lock_filename)) + && !NILP (Ffile_exists_p (fn)) && current_lock_owner (NULL, lfname) != -2) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); commit 662f91a795c0b5480b1733a99ef478c94d6f1426 Author: Eli Zaretskii Date: Thu Jul 22 21:23:48 2021 +0300 Fix display of line/wrap-prefix when there's a display property at BOL * src/xdisp.c (get_line_prefix_it_property): New function. (handle_line_prefix): Call 'get_line_prefix_it_property' instead of 'get_it_property', to examine also the property of the buffer text underlying the display or overlay string. (Bug#49695) diff --git a/src/xdisp.c b/src/xdisp.c index 50ab2f8e05..70d15aee68 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -22763,6 +22763,22 @@ get_it_property (struct it *it, Lisp_Object prop) return Fget_char_property (position, prop, object); } +/* Return the line-prefix/wrap-prefix property, checking both the + current IT->OBJECT and the underlying buffer text. */ + +static Lisp_Object +get_line_prefix_it_property (struct it *it, Lisp_Object prop) +{ + Lisp_Object prefix = get_it_property (it, prop); + + /* If we are looking at a display or overlay string, check also the + underlying buffer text. */ + if (NILP (prefix) && it->sp > 0 && STRINGP (it->object)) + return Fget_char_property (make_fixnum (IT_CHARPOS (*it)), prop, + it->w->contents); + return prefix; +} + /* See if there's a line- or wrap-prefix, and if so, push it on IT. */ static void @@ -22772,13 +22788,13 @@ handle_line_prefix (struct it *it) if (it->continuation_lines_width > 0) { - prefix = get_it_property (it, Qwrap_prefix); + prefix = get_line_prefix_it_property (it, Qwrap_prefix); if (NILP (prefix)) prefix = Vwrap_prefix; } else { - prefix = get_it_property (it, Qline_prefix); + prefix = get_line_prefix_it_property (it, Qline_prefix); if (NILP (prefix)) prefix = Vline_prefix; } commit fcae435f598471a2911641412125c5ac4f73559f Author: Lars Ingebrigtsen Date: Thu Jul 22 16:24:58 2021 +0200 Make revert-buffer preserve buffer-readedness * lisp/files.el (revert-buffer): Preserve buffer-readedness (bug#35166). diff --git a/etc/NEWS b/etc/NEWS index bf19c34f02..95218faa1b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2804,6 +2804,9 @@ similar to prefix arguments, but are more flexible and discoverable. * Incompatible Editing Changes in Emacs 28.1 +** 'revert-buffer' will now preserve buffer-readedness. +It previously switched the read-only flag off. + ** 'electric-indent-mode' now also indents inside strings and comments, (unless the indentation function doesn't, of course). To recover the previous behavior you can use: diff --git a/lisp/files.el b/lisp/files.el index 0606ed6482..412562fc9a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6317,7 +6317,9 @@ preserve markers and overlays, at the price of being slower." ;; interface, but leaving the programmatic interface the same. (interactive (list (not current-prefix-arg))) (let ((revert-buffer-in-progress-p t) - (revert-buffer-preserve-modes preserve-modes)) + (revert-buffer-preserve-modes preserve-modes) + ;; Preserve buffer-readedness. + (buffer-read-only buffer-read-only)) (funcall (or revert-buffer-function #'revert-buffer--default) ignore-auto noconfirm))) commit 16860f6c5f51a1c9d3ea1dbd6191baeaf9aa23e5 Author: Lars Ingebrigtsen Date: Thu Jul 22 16:17:59 2021 +0200 `term-char-mode' doc string clarification * lisp/term.el (term-char-mode): Document behaviour (bug#49186). diff --git a/lisp/term.el b/lisp/term.el index 560549ece9..27f0bb1be3 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1298,7 +1298,10 @@ without any interpretation." (defun term-char-mode () "Switch to char (\"raw\") sub-mode of term mode. Each character you type is sent directly to the inferior without -intervention from Emacs, except for the escape character (usually C-c)." +intervention from Emacs, except for the escape character (usually C-c). + +This command will send existing partial lines to the terminal +process." (interactive) ;; FIXME: Emit message? Cfr ilisp-raw-message (when (term-in-line-mode) commit a2d0ff26005c5c10ffe0d84bd8b458a06828be82 Author: Dmitry Gutov Date: Thu Jul 22 14:41:52 2021 +0200 Bind the GIT_LITERAL_PATHSPECS environment variable * lisp/vc/vc-git.el (vc-git-command): (vc-git--call): Ensure that git interprets file names literally (bug#39452). diff --git a/etc/NEWS b/etc/NEWS index b1db3b7c33..bf19c34f02 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -886,6 +886,12 @@ keys, add the following to your init file: ** Change Logs and VC +*** vc-git now sets the GIT_LITERAL_PATHSPECS environment variable. +This ensures that Git operations on files containing wildcard +characters work as they're supposed to. However, this also affects +scripts running from Git hooks, and these have to "unset +GIT_LITERAL_PATHSPECS" to work as before. + *** More VC commands can be used from non-file buffers. The relevant commands are those that don't change the VC state. The non-file buffers which can use VC commands are those that have diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 5828a83deb..143087122f 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1772,6 +1772,7 @@ The difference to vc-do-command is that this function always invokes (process-environment (append `("GIT_DIR" + "GIT_LITERAL_PATHSPECS=1" ;; Avoid repository locking during background operations ;; (bug#21559). ,@(when revert-buffer-in-progress-p @@ -1806,6 +1807,7 @@ The difference to vc-do-command is that this function always invokes (process-environment (append `("GIT_DIR" + "GIT_LITERAL_PATHSPECS=1" ;; Avoid repository locking during background operations ;; (bug#21559). ,@(when revert-buffer-in-progress-p commit 6f9ff3d7493d144af182ddd6fcf512f98b78ad0c Author: Sergey Organov Date: Thu Jul 22 14:22:26 2021 +0200 Avoid failing in desktop-clear due to killed buffers * lisp/desktop.el (desktop-clear): check that buffer is not already killed before attempting to kill it. A buffer might become killed as part of regular operation as a side-effect of killing another buffer, and then attempt to kill it again causes error (bug#49692). Copyright-paperwork-exempt: yes diff --git a/lisp/desktop.el b/lisp/desktop.el index b9467c8752..3b25713216 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -706,8 +706,9 @@ if different)." "\\)\\'"))) (dolist (buffer (buffer-list)) (let ((bufname (buffer-name buffer))) - (unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers - (string-match-p preserve-regexp bufname)) + (unless (or (null bufname) + (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers + (string-match-p preserve-regexp bufname)) (kill-buffer buffer))))) (delete-other-windows) (when (and desktop-restore-frames commit 0dcc4449812658ab289c26e2b11c0d5bbf69a2cc Author: Lars Ingebrigtsen Date: Thu Jul 22 14:14:33 2021 +0200 Remove the (value) bits from cus-start Customize strings * lisp/cus-start.el (standard): Don't mention the Lisp values in the choice strings, because that's just confusing in the Customize interface (bug#49687). diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 50a6bd2f75..7df70d704e 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -306,8 +306,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (use-short-answers menu boolean "28.1") (focus-follows-mouse frames (choice - (const :tag "Off (nil)" :value nil) - (const :tag "On (t)" :value t) + (const :tag "Off" :value nil) + (const :tag "On" :value t) (const :tag "Auto-raise" :value auto-raise)) "26.1") ;; fontset.c ;; FIXME nil is the initial value, fontset.el setqs it. @@ -603,27 +603,29 @@ since it could result in memory overflow and make Emacs crash." (next-screen-context-lines windows integer) (scroll-preserve-screen-position windows (choice - (const :tag "Off (nil)" :value nil) - (const :tag "Full screen (t)" :value t) - (other :tag "Always" 1)) "22.1") + (const :tag "Off" :value nil) + (const :tag "Full screen" :value t) + (other :tag "Always" 1)) + "22.1") (recenter-redisplay windows (choice - (const :tag "Never (nil)" :value nil) + (const :tag "Never" :value nil) (const :tag "Only on ttys" :value tty) - (other :tag "Always" t)) "23.1") + (other :tag "Always" t)) + "23.1") (window-combination-resize windows boolean "24.1") (window-combination-limit windows (choice - (const :tag "Never (nil)" :value nil) - (const :tag "If requested via buffer display alist (window-size)" + (const :tag "Never" :value nil) + (const :tag "If requested via buffer display alist" :value window-size) - (const :tag "With Temp Buffer Resize mode (temp-buffer-resize)" + (const :tag "With Temp Buffer Resize mode" :value temp-buffer-resize) - (const :tag "For temporary buffers (temp-buffer)" + (const :tag "For temporary buffers" :value temp-buffer) - (const :tag "For buffer display (display-buffer)" + (const :tag "For buffer display" :value display-buffer) - (other :tag "Always (t)" :value t)) + (other :tag "Always" :value t)) "26.1") (fast-but-imprecise-scrolling scrolling boolean "25.1") (window-resize-pixelwise windows boolean "24.4") @@ -633,9 +635,9 @@ since it could result in memory overflow and make Emacs crash." :safe booleanp) (mode-line-compact mode-line - (choice (const :tag "Never (nil)" :value nil) - (const :tag "Only if wider than window (long)" :value long) - (const :tag "Always (t)" :value t)) + (choice (const :tag "Never" :value nil) + (const :tag "Only if wider than window" :value long) + (const :tag "Always" :value t)) "28.1") (scroll-step windows integer) (scroll-conservatively windows integer) @@ -674,7 +676,7 @@ since it could result in memory overflow and make Emacs crash." (underline-minimum-offset display integer "23.1") (mouse-autoselect-window display (choice - (const :tag "Off (nil)" :value nil) + (const :tag "Off" :value nil) (const :tag "Immediate" :value t) (number :tag "Delay by secs" :value 0.5)) "22.1") (tool-bar-style @@ -719,15 +721,15 @@ since it could result in memory overflow and make Emacs crash." (hourglass-delay cursor number) (resize-mini-windows windows (choice - (const :tag "Off (nil)" :value nil) - (const :tag "Fit (t)" :value t) + (const :tag "Off" :value nil) + (const :tag "Fit" :value t) (const :tag "Grow only" :value grow-only)) "25.1") (display-raw-bytes-as-hex display boolean "26.1") (display-line-numbers display-line-numbers (choice - (const :tag "Off (nil)" :value nil) + (const :tag "Off" :value nil) (const :tag "Absolute line numbers" :value t) (const :tag "Relative line numbers" commit c8a1af6d3726ee57392dbea40ecca51c793224c4 Author: Eli Zaretskii Date: Thu Jul 22 12:14:50 2021 +0300 Avoid byte-compilation warning * test/src/buffer-tests.el (buffer-tests-inhibit-buffer-hooks): Avoid byte-compiler warning. (Bug#49667) diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 20f85c6c93..11f842e8fe 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1345,8 +1345,8 @@ with parameters from the *Messages* buffer modification." (add-hook 'kill-buffer-hook kbh nil t) (add-hook 'kill-buffer-query-functions kbqf nil t) (kill-buffer)) - (with-temp-buffer) - (with-output-to-string) + (with-temp-buffer (ignore)) + (with-output-to-string (ignore)) (should-not run-bluh) (should-not run-kbh) (should-not run-kbqf) commit 3edc4fb5d8931f49ec939c97107c393d554edf90 Author: Eli Zaretskii Date: Thu Jul 22 10:31:14 2021 +0300 ; * lisp/emacs-lisp/macroexp.el (macroexp-warn-and-return): Doc fix. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 48311f56de..61c1ea490f 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -146,11 +146,11 @@ Other uses risk returning non-nil value that point to the wrong file." (define-obsolete-function-alias 'macroexp--warn-and-return #'macroexp-warn-and-return "28.1") (defun macroexp-warn-and-return (msg form &optional category compile-only) - "Return code equivalent to FORM by labeled with warning MSG. + "Return code equivalent to FORM labeled with warning MSG. CATEGORY is the category of the warning, like the categories that can appear in `byte-compile-warnings'. -COMPILE-ONLY if non-nil indicates that no warning should be emitted if -the code is executed without being compiled first." +COMPILE-ONLY non-nil means no warning should be emitted if the code +is executed without being compiled first." (cond ((null msg) form) ((macroexp-compiling-p) commit a82855732019622ebe1cfac9055d84366f3608f2 Author: Lars Ingebrigtsen Date: Thu Jul 22 00:21:34 2021 +0200 Move generalized variable specs from cl-lib.el to gv.el * lisp/emacs-lisp/cl-lib.el: Move all the generalized variable specifications from cl-lib.el... * lisp/emacs-lisp/gv.el: ... to gv.el. This will make things like `(setf (getenv "FOO") "BAR")' work without requiring anything, since `setf' lives in gv.el (bug#49651). diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 7f7eb96342..317a4c6230 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -515,111 +515,6 @@ the process stops as soon as KEYS or VALUES run out. If ALIST is non-nil, the new pairs are prepended to it." (nconc (cl-mapcar 'cons keys values) alist)) -;;; Generalized variables. - -;; These used to be in cl-macs.el since all macros that use them (like setf) -;; were autoloaded from cl-macs.el. But now that setf, push, and pop are in -;; core Elisp, they need to either be right here or be autoloaded via -;; cl-loaddefs.el, which is more trouble than it is worth. - -;; Some more Emacs-related place types. -(gv-define-simple-setter buffer-file-name set-visited-file-name t) -(gv-define-setter buffer-modified-p (flag &optional buf) - (macroexp-let2 nil buffer `(or ,buf (current-buffer)) - `(with-current-buffer ,buffer - (set-buffer-modified-p ,flag)))) -(gv-define-simple-setter buffer-name rename-buffer t) -(gv-define-setter buffer-string (store) - `(insert (prog1 ,store (erase-buffer)))) -(gv-define-simple-setter buffer-substring cl--set-buffer-substring) -(gv-define-simple-setter current-buffer set-buffer) -(gv-define-simple-setter current-column move-to-column t) -(gv-define-simple-setter current-global-map use-global-map t) -(gv-define-setter current-input-mode (store) - `(progn (apply #'set-input-mode ,store) ,store)) -(gv-define-simple-setter current-local-map use-local-map t) -(gv-define-simple-setter current-window-configuration - set-window-configuration t) -(gv-define-simple-setter default-file-modes set-default-file-modes t) -(gv-define-simple-setter documentation-property put) -(gv-define-setter face-background (x f &optional s) - `(set-face-background ,f ,x ,s)) -(gv-define-setter face-background-pixmap (x f &optional s) - `(set-face-background-pixmap ,f ,x ,s)) -(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s)) -(gv-define-setter face-foreground (x f &optional s) - `(set-face-foreground ,f ,x ,s)) -(gv-define-setter face-underline-p (x f &optional s) - `(set-face-underline ,f ,x ,s)) -(gv-define-simple-setter file-modes set-file-modes t) -(gv-define-setter frame-height (x &optional frame) - `(set-frame-height (or ,frame (selected-frame)) ,x)) -(gv-define-simple-setter frame-parameters modify-frame-parameters t) -(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p) -(gv-define-setter frame-width (x &optional frame) - `(set-frame-width (or ,frame (selected-frame)) ,x)) -(gv-define-simple-setter getenv setenv t) -(gv-define-simple-setter get-register set-register) -(gv-define-simple-setter global-key-binding global-set-key) -(gv-define-simple-setter local-key-binding local-set-key) -(gv-define-simple-setter mark set-mark t) -(gv-define-simple-setter mark-marker set-mark t) -(gv-define-simple-setter marker-position set-marker t) -(gv-define-setter mouse-position (store scr) - `(set-mouse-position ,scr (car ,store) (cadr ,store) - (cddr ,store))) -(gv-define-simple-setter point goto-char) -(gv-define-simple-setter point-marker goto-char t) -(gv-define-setter point-max (store) - `(progn (narrow-to-region (point-min) ,store) ,store)) -(gv-define-setter point-min (store) - `(progn (narrow-to-region ,store (point-max)) ,store)) -(gv-define-setter read-mouse-position (store scr) - `(set-mouse-position ,scr (car ,store) (cdr ,store))) -(gv-define-simple-setter screen-height set-screen-height t) -(gv-define-simple-setter screen-width set-screen-width t) -(gv-define-simple-setter selected-window select-window) -(gv-define-simple-setter selected-screen select-screen) -(gv-define-simple-setter selected-frame select-frame) -(gv-define-simple-setter standard-case-table set-standard-case-table) -(gv-define-simple-setter syntax-table set-syntax-table) -(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t) -(gv-define-setter window-height (store) - `(progn (enlarge-window (- ,store (window-height))) ,store)) -(gv-define-setter window-width (store) - `(progn (enlarge-window (- ,store (window-width)) t) ,store)) -(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t) - -;; More complex setf-methods. - -;; This is a hack that allows (setf (eq a 7) B) to mean either -;; (setq a 7) or (setq a nil) depending on whether B is nil or not. -;; This is useful when you have control over the PLACE but not over -;; the VALUE, as is the case in define-minor-mode's :variable. -;; It turned out that :variable needed more flexibility anyway, so -;; this doesn't seem too useful now. -(gv-define-expander eq - (lambda (do place val) - (gv-letplace (getter setter) place - (macroexp-let2 nil val val - (funcall do `(eq ,getter ,val) - (lambda (v) - `(cond - (,v ,(funcall setter val)) - ((eq ,getter ,val) ,(funcall setter `(not ,val)))))))))) - -(gv-define-expander substring - (lambda (do place from &optional to) - (gv-letplace (getter setter) place - (macroexp-let2* nil ((start from) (end to)) - (funcall do `(substring ,getter ,start ,end) - (lambda (v) - (macroexp-let2 nil v v - `(progn - ,(funcall setter `(cl--set-substring - ,getter ,start ,end ,v)) - ,v)))))))) - ;;; Miscellaneous. (provide 'cl-lib) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index f08f7ac115..d6272a5246 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -614,5 +614,105 @@ REF must have been previously obtained with `gv-ref'." ;; (,(nth 1 vars) (v) (funcall ',setter v))) ;; ,@body))) +;;; Generalized variables. + +;; Some Emacs-related place types. +(gv-define-simple-setter buffer-file-name set-visited-file-name t) +(gv-define-setter buffer-modified-p (flag &optional buf) + (macroexp-let2 nil buffer `(or ,buf (current-buffer)) + `(with-current-buffer ,buffer + (set-buffer-modified-p ,flag)))) +(gv-define-simple-setter buffer-name rename-buffer t) +(gv-define-setter buffer-string (store) + `(insert (prog1 ,store (erase-buffer)))) +(gv-define-simple-setter buffer-substring cl--set-buffer-substring) +(gv-define-simple-setter current-buffer set-buffer) +(gv-define-simple-setter current-column move-to-column t) +(gv-define-simple-setter current-global-map use-global-map t) +(gv-define-setter current-input-mode (store) + `(progn (apply #'set-input-mode ,store) ,store)) +(gv-define-simple-setter current-local-map use-local-map t) +(gv-define-simple-setter current-window-configuration + set-window-configuration t) +(gv-define-simple-setter default-file-modes set-default-file-modes t) +(gv-define-simple-setter documentation-property put) +(gv-define-setter face-background (x f &optional s) + `(set-face-background ,f ,x ,s)) +(gv-define-setter face-background-pixmap (x f &optional s) + `(set-face-background-pixmap ,f ,x ,s)) +(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s)) +(gv-define-setter face-foreground (x f &optional s) + `(set-face-foreground ,f ,x ,s)) +(gv-define-setter face-underline-p (x f &optional s) + `(set-face-underline ,f ,x ,s)) +(gv-define-simple-setter file-modes set-file-modes t) +(gv-define-setter frame-height (x &optional frame) + `(set-frame-height (or ,frame (selected-frame)) ,x)) +(gv-define-simple-setter frame-parameters modify-frame-parameters t) +(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p) +(gv-define-setter frame-width (x &optional frame) + `(set-frame-width (or ,frame (selected-frame)) ,x)) +(gv-define-simple-setter getenv setenv t) +(gv-define-simple-setter get-register set-register) +(gv-define-simple-setter global-key-binding global-set-key) +(gv-define-simple-setter local-key-binding local-set-key) +(gv-define-simple-setter mark set-mark t) +(gv-define-simple-setter mark-marker set-mark t) +(gv-define-simple-setter marker-position set-marker t) +(gv-define-setter mouse-position (store scr) + `(set-mouse-position ,scr (car ,store) (cadr ,store) + (cddr ,store))) +(gv-define-simple-setter point goto-char) +(gv-define-simple-setter point-marker goto-char t) +(gv-define-setter point-max (store) + `(progn (narrow-to-region (point-min) ,store) ,store)) +(gv-define-setter point-min (store) + `(progn (narrow-to-region ,store (point-max)) ,store)) +(gv-define-setter read-mouse-position (store scr) + `(set-mouse-position ,scr (car ,store) (cdr ,store))) +(gv-define-simple-setter screen-height set-screen-height t) +(gv-define-simple-setter screen-width set-screen-width t) +(gv-define-simple-setter selected-window select-window) +(gv-define-simple-setter selected-screen select-screen) +(gv-define-simple-setter selected-frame select-frame) +(gv-define-simple-setter standard-case-table set-standard-case-table) +(gv-define-simple-setter syntax-table set-syntax-table) +(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t) +(gv-define-setter window-height (store) + `(progn (enlarge-window (- ,store (window-height))) ,store)) +(gv-define-setter window-width (store) + `(progn (enlarge-window (- ,store (window-width)) t) ,store)) +(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t) + +;; More complex setf-methods. + +;; This is a hack that allows (setf (eq a 7) B) to mean either +;; (setq a 7) or (setq a nil) depending on whether B is nil or not. +;; This is useful when you have control over the PLACE but not over +;; the VALUE, as is the case in define-minor-mode's :variable. +;; It turned out that :variable needed more flexibility anyway, so +;; this doesn't seem too useful now. +(gv-define-expander eq + (lambda (do place val) + (gv-letplace (getter setter) place + (macroexp-let2 nil val val + (funcall do `(eq ,getter ,val) + (lambda (v) + `(cond + (,v ,(funcall setter val)) + ((eq ,getter ,val) ,(funcall setter `(not ,val)))))))))) + +(gv-define-expander substring + (lambda (do place from &optional to) + (gv-letplace (getter setter) place + (macroexp-let2* nil ((start from) (end to)) + (funcall do `(substring ,getter ,start ,end) + (lambda (v) + (macroexp-let2 nil v v + `(progn + ,(funcall setter `(cl--set-substring + ,getter ,start ,end ,v)) + ,v)))))))) + (provide 'gv) ;;; gv.el ends here commit 38a62efc15ddd849219ef1bdc98da933b5b1c33c Author: Yan Gajdos Date: Wed Jul 21 23:56:44 2021 +0200 Make vc-git-mode-line-string more robust * lisp/vc/vc-git.el (vc-git-mode-line-string): Make function more robust (bug#49683). It could previously error out under certain conditions, like moving directories in and out of the VC-controlled tree. Copyright-paperwork-exempt: yes diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 89f9800a1b..5828a83deb 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -375,7 +375,7 @@ in the order given by `git status'." "Return a string for `vc-mode-line' to put in the mode line for FILE." (let* ((rev (vc-working-revision file 'Git)) (disp-rev (or (vc-git--symbolic-ref file) - (substring rev 0 7))) + (and rev (substring rev 0 7)))) (def-ml (vc-default-mode-line-string 'Git file)) (help-echo (get-text-property 0 'help-echo def-ml)) (face (get-text-property 0 'face def-ml))) commit a98bf3e7d713cb944c38ae6f784dc26d532b8e71 Author: Illia Ostapyshyn Date: Wed Jul 21 23:53:17 2021 +0200 * lisp/cus-start.el: Add mode-line-compact to Customize * lisp/cus-start.el (standard): Make `mode-line-compact' into a user option (bug#49687). Copyright-paperwork-exempt: yes diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 3c2625a8c3..50a6bd2f75 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -631,6 +631,12 @@ since it could result in memory overflow and make Emacs crash." ;; The whitespace group is for whitespace.el. (show-trailing-whitespace editing-basics boolean nil :safe booleanp) + (mode-line-compact + mode-line + (choice (const :tag "Never (nil)" :value nil) + (const :tag "Only if wider than window (long)" :value long) + (const :tag "Always (t)" :value t)) + "28.1") (scroll-step windows integer) (scroll-conservatively windows integer) (scroll-margin windows integer) commit 903ecd7bea7d8f99a7dc84150728219283d79bf0 Author: Logan Perkins Date: Wed Jul 21 17:56:20 2021 +0200 Make input of multi-key inputs in different emacsclients more logical * src/keyboard.c (read_key_sequence): Don't continue the input of multi-key commands in one emacsclient in another (bug#39687). diff --git a/src/keyboard.c b/src/keyboard.c index 38118071a8..820229cf8f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -9619,17 +9619,23 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, (interrupted_kboard, Fcons (make_lispy_switch_frame (frame), KVAR (interrupted_kboard, kbd_queue))); + mock_input = 0; + } + else + { + if (FIXNUMP (key) && XFIXNUM (key) != -2) + { + /* If interrupted while initializing terminal, we + need to replay the interrupting key. See + Bug#5095 and Bug#37782. */ + mock_input = 1; + keybuf[0] = key; + } + else + { + mock_input = 0; + } } - if (FIXNUMP (key) && XFIXNUM (key) != -2) - { - /* If interrupted while initializing terminal, we - need to replay the interrupting key. See - Bug#5095 and Bug#37782. */ - mock_input = 1; - keybuf[0] = key; - } - else - mock_input = 0; goto replay_entire_sequence; } } commit 0576b81ca79c9cb0c156de66c924b1610e26dcff Author: Stefan Monnier Date: Wed Jul 21 11:12:25 2021 -0400 * src/eval.c (signal_quit_p): Fix the usual int/Lisp_Object mixup diff --git a/src/eval.c b/src/eval.c index ddf7e703fc..48104bd0f4 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2033,9 +2033,9 @@ signal_quit_p (Lisp_Object signal) Lisp_Object list; return EQ (signal, Qquit) - || (Fsymbolp (signal) + || (!NILP (Fsymbolp (signal)) && CONSP (list = Fget (signal, Qerror_conditions)) - && Fmemq (Qquit, list)); + && !NILP (Fmemq (Qquit, list))); } /* Call the debugger if calling it is currently enabled for CONDITIONS. commit 52187012f1772bc9ccbe3376991bb35732a76501 Author: Stefan Monnier Date: Wed Jul 21 11:11:50 2021 -0400 * lisp/emacs-lisp/macroexp.el (macroexp-warn-and-return): Add arg `category` Use it to obey `byte-compile-warnings`. (macroexp--warn-wrap): Add arg `category`. (macroexp-macroexpand, macroexp--expand-all): Use it. * lisp/emacs-lisp/cconv.el (cconv--convert-funcbody, cconv-convert): Mark the warnings as `lexical`. * lisp/emacs-lisp/eieio-core.el (eieio-oref, eieio-oref-default) (eieio-oset-default): * lisp/emacs-lisp/eieio.el (defclass): Adjust to new calling convention. diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index f1579cda8b..ea0b09805e 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -259,8 +259,7 @@ Returns a form where all lambdas don't have any free variables." (not (intern-soft var)) (eq ?_ (aref (symbol-name var) 0)) ;; As a special exception, ignore "ignore". - (eq var 'ignored) - (not (byte-compile-warning-enabled-p 'unbound var))) + (eq var 'ignored)) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) (format "Unused lexical %s `%S'%s" varkind var @@ -287,7 +286,7 @@ of converted forms." (let (and (pred stringp) msg) (cconv--warn-unused-msg arg "argument"))) (if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed? - (push (lambda (body) (macroexp--warn-wrap msg body)) wrappers)) + (push (lambda (body) (macroexp--warn-wrap msg body 'lexical)) wrappers)) (_ (if (assq arg env) (push `(,arg . nil) env))))) (setq funcbody (mapcar (lambda (form) @@ -408,7 +407,7 @@ places where they originally did not directly appear." `(ignore ,(cconv-convert value env extend))) (msg (cconv--warn-unused-msg var "variable"))) (if (null msg) newval - (macroexp--warn-wrap msg newval)))) + (macroexp--warn-wrap msg newval 'lexical)))) ;; Normal default case. (_ @@ -507,7 +506,7 @@ places where they originally did not directly appear." (newprotform (cconv-convert protected-form env extend))) `(condition-case ,var ,(if msg - (macroexp--warn-wrap msg newprotform) + (macroexp--warn-wrap msg newprotform 'lexical) newprotform) ,@(mapcar (lambda (handler) @@ -599,14 +598,16 @@ FORM is the parent form that binds this var." (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) ,_ ,_ ,_ ,_) ;; FIXME: Convert this warning to use `macroexp--warn-wrap' - ;; so as to give better position information. + ;; so as to give better position information and obey + ;; `byte-compile-warnings'. (byte-compile-warn "%s `%S' not left unused" varkind var)) ((and (let (or 'let* 'let) (car form)) `((,var) ;; (or `(,var nil) : Too many false positives: bug#47080 t nil ,_ ,_)) ;; FIXME: Convert this warning to use `macroexp--warn-wrap' - ;; so as to give better position information. + ;; so as to give better position information and obey + ;; `byte-compile-warnings'. (unless (not (intern-soft var)) (byte-compile-warn "Variable `%S' left uninitialized" var)))) (pcase vardata diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 8f1e38b613..b11ed3333f 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -742,7 +742,8 @@ Argument FN is the function calling this verifier." ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-slot-names)))) (macroexp-warn-and-return - (format-message "Unknown slot `%S'" name) exp 'compile-only)) + (format-message "Unknown slot `%S'" name) + exp nil 'compile-only)) (_ exp)))) (gv-setter eieio-oset)) (cl-check-type slot symbol) @@ -777,12 +778,13 @@ Fills in CLASS's SLOT with its default value." ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-slot-names)))) (macroexp-warn-and-return - (format-message "Unknown slot `%S'" name) exp 'compile-only)) + (format-message "Unknown slot `%S'" name) + exp nil 'compile-only)) ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-class-slot-names)))) (macroexp-warn-and-return (format-message "Slot `%S' is not class-allocated" name) - exp 'compile-only)) + exp nil 'compile-only)) (_ exp))))) (cl-check-type class (or eieio-object class)) (cl-check-type slot symbol) @@ -838,12 +840,13 @@ Fills in the default value in CLASS' in SLOT with VALUE." ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-slot-names)))) (macroexp-warn-and-return - (format-message "Unknown slot `%S'" name) exp 'compile-only)) + (format-message "Unknown slot `%S'" name) + exp nil 'compile-only)) ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-class-slot-names)))) (macroexp-warn-and-return (format-message "Slot `%S' is not class-allocated" name) - exp 'compile-only)) + exp nil 'compile-only)) (_ exp))))) (setq class (eieio--class-object class)) (cl-check-type class eieio--class) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index b31ea42a99..c16d8e110e 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -241,7 +241,8 @@ This method is obsolete." )) `(progn - ,@(mapcar (lambda (w) (macroexp-warn-and-return w `(progn ',w) 'compile-only)) + ,@(mapcar (lambda (w) + (macroexp-warn-and-return w `(progn ',w) nil 'compile-only)) warnings) ;; This test must be created right away so we can have self- ;; referencing classes. ei, a class whose slot can contain only @@ -742,7 +743,7 @@ Called from the constructor routine." (cl-defmethod initialize-instance ((this eieio-default-superclass) &optional args) - "Construct the new object THIS based on SLOTS. + "Construct the new object THIS based on ARGS. ARGS is a property list where odd numbered elements are tags, and even numbered elements are the values to store in the tagged slot. If you overload the `initialize-instance', there you will need to diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index f4bab9c345..48311f56de 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -135,15 +135,22 @@ Other uses risk returning non-nil value that point to the wrong file." (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key)) -(defun macroexp--warn-wrap (msg form) - (let ((when-compiled (lambda () (byte-compile-warn "%s" msg)))) +(defun macroexp--warn-wrap (msg form category) + (let ((when-compiled (lambda () + (when (byte-compile-warning-enabled-p category) + (byte-compile-warn "%s" msg))))) `(progn (macroexp--funcall-if-compiled ',when-compiled) ,form))) (define-obsolete-function-alias 'macroexp--warn-and-return #'macroexp-warn-and-return "28.1") -(defun macroexp-warn-and-return (msg form &optional compile-only) +(defun macroexp-warn-and-return (msg form &optional category compile-only) + "Return code equivalent to FORM by labeled with warning MSG. +CATEGORY is the category of the warning, like the categories that +can appear in `byte-compile-warnings'. +COMPILE-ONLY if non-nil indicates that no warning should be emitted if +the code is executed without being compiled first." (cond ((null msg) form) ((macroexp-compiling-p) @@ -153,7 +160,7 @@ Other uses risk returning non-nil value that point to the wrong file." ;; macroexpand-all gets right back to macroexpanding `form'. form (puthash form form macroexp--warned) - (macroexp--warn-wrap msg form))) + (macroexp--warn-wrap msg form category))) (t (unless compile-only (message "%sWarning: %s" @@ -205,9 +212,7 @@ Other uses risk returning non-nil value that point to the wrong file." (if (and (not (eq form new-form)) ;It was a macro call. (car-safe form) (symbolp (car form)) - (get (car form) 'byte-obsolete-info) - (or (not (fboundp 'byte-compile-warning-enabled-p)) - (byte-compile-warning-enabled-p 'obsolete (car form)))) + (get (car form) 'byte-obsolete-info)) (let* ((fun (car form)) (obsolete (get fun 'byte-obsolete-info))) (macroexp-warn-and-return @@ -215,7 +220,7 @@ Other uses risk returning non-nil value that point to the wrong file." fun obsolete (if (symbolp (symbol-function fun)) "alias" "macro")) - new-form)) + new-form 'obsolete)) new-form))) (defun macroexp--unfold-lambda (form &optional name) @@ -325,10 +330,8 @@ Assumes the caller has bound `macroexpand-all-environment'." (if (null body) (macroexp-unprogn (macroexp-warn-and-return - (and (or (not (fboundp 'byte-compile-warning-enabled-p)) - (byte-compile-warning-enabled-p t)) - (format "Empty %s body" fun)) - nil t)) + (format "Empty %s body" fun) + nil nil 'compile-only)) (macroexp--all-forms body)) (cdr form)) form)) commit da4b3973deb5eb271d79568092ad25560b65dbf8 Author: Lars Ingebrigtsen Date: Wed Jul 21 16:53:54 2021 +0200 Make `C-g' after `M-x' not give a backtrace unless required * src/eval.c (signal_quit_p): New function. (maybe_call_debugger): React to all `quit' signals (bug#49675). * src/keyboard.c (cmd_error_internal, menu_item_eval_property_1): Ditto. diff --git a/src/eval.c b/src/eval.c index b76ced79d6..ddf7e703fc 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2026,6 +2026,18 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data) return 0; } +/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */ +bool +signal_quit_p (Lisp_Object signal) +{ + Lisp_Object list; + + return EQ (signal, Qquit) + || (Fsymbolp (signal) + && CONSP (list = Fget (signal, Qerror_conditions)) + && Fmemq (Qquit, list)); +} + /* Call the debugger if calling it is currently enabled for CONDITIONS. SIG and DATA describe the signal. There are two ways to pass them: = SIG is the error symbol, and DATA is the rest of the data. @@ -2044,7 +2056,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) ! input_blocked_p () && NILP (Vinhibit_debugger) /* Does user want to enter debugger for this kind of error? */ - && (EQ (sig, Qquit) + && (signal_quit_p (sig) ? debug_on_quit : wants_debugger (Vdebug_on_error, conditions)) && ! skip_debugger (conditions, combined_data) diff --git a/src/keyboard.c b/src/keyboard.c index db93468659..38118071a8 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -985,7 +985,7 @@ cmd_error_internal (Lisp_Object data, const char *context) { /* The immediate context is not interesting for Quits, since they are asynchronous. */ - if (EQ (XCAR (data), Qquit)) + if (signal_quit_p (XCAR (data))) Vsignaling_function = Qnil; Vquit_flag = Qnil; @@ -7634,7 +7634,7 @@ menu_item_eval_property_1 (Lisp_Object arg) { /* If we got a quit from within the menu computation, quit all the way out of it. This takes care of C-] in the debugger. */ - if (CONSP (arg) && EQ (XCAR (arg), Qquit)) + if (CONSP (arg) && signal_quit_p (XCAR (arg))) quit (); return Qnil; diff --git a/src/lisp.h b/src/lisp.h index b3f1dc16b1..80efd77113 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4116,6 +4116,7 @@ extern Lisp_Object Vautoload_queue; extern Lisp_Object Vrun_hooks; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; +extern bool signal_quit_p (Lisp_Object); /* To run a normal hook, use the appropriate function from the list below. The calling convention: commit e3b8ddd5005903465ec86823559a2e884c7b13f2 Author: Jashank Jeremy Date: Wed Jul 21 16:01:03 2021 +0200 Speed up by storing frame faces in hash tables instead of alists * src/frame.h (struct frame): Add face_hash_table, remove face_alist. (fset_face_hash_table): New function. (fset_face_alist): Remove. * src/frame.c (make_frame): Initialize f->face_hash_table. (Fmake_terminal_frame): Update to work with hash tables instead of alists. * src/xfaces.c (lface_from_face_name_no_resolve): (Finternal_make_lisp_face): (update_face_from_frame_parameter): Update to work with hash tables instead of alists. (Fframe_face_hash_table): New function. (Fframe_face_alist): Move to faces.el as frame-face-alist. (syms_of_xfaces): Add frame_face_hash_table. * lisp/progmodes/elisp-mode.el (elisp--eval-defun-1): * lisp/frame.el (frame-set-background-mode): Update to work with hash tables instead of alists. * lisp/faces.el (face-new-frame-defaults): Mark obsolete. (face-list): Update to use face--new-frame-defaults. (frame-face-alist): Moved here from src/xfaces.c. (x-create-frame-with-faces): Update to handle subtle semantic change to how frame faces propagate, which otherwise breaks frame creation with reverse video enabled (bug#41200). Reworked from a patch by Clément Pit-Claudel . diff --git a/lisp/custom.el b/lisp/custom.el index 1db3f4fd39..f392bd8d36 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -926,7 +926,7 @@ See `custom-known-themes' for a list of known themes." ;; the value to a fake theme, `changed'. If the theme is ;; later disabled, we use this to bring back the old value. ;; - ;; For faces, we just use `face-new-frame-defaults' to + ;; For faces, we just use `face--new-frame-defaults' to ;; recompute when the theme is disabled. (when (and (eq prop 'theme-value) (boundp symbol)) diff --git a/lisp/faces.el b/lisp/faces.el index af2f37df96..4bb3a2b00f 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -176,10 +176,28 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc." ;;; Creation, copying. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(make-obsolete-variable 'face-new-frame-defaults + "use `face--new-frame-defaults' or `face-alist' instead." "28.1") + +(defun frame-face-alist (&optional frame) + "Return an alist of frame-local faces defined on FRAME. +This alist is a copy of the contents of `frame--face-hash-table'. +For internal use only." + (declare (obsolete frame--face-hash-table "28.1")) + (let (faces) + (maphash (lambda (face spec) + (let ((face-id (car (gethash face face--new-frame-defaults)))) + (push `(,face-id ,face . ,spec) faces))) + (frame--face-hash-table frame)) + (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2))))))) (defun face-list () "Return a list of all defined faces." - (mapcar #'car face-new-frame-defaults)) + (let (faces) + (maphash (lambda (face spec) + (push `(,(car spec) . ,face) faces)) + face--new-frame-defaults) + (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2))))))) (defun make-face (face) "Define a new face with name FACE, a symbol. @@ -2115,6 +2133,8 @@ the X resource \"reverseVideo\" is present, handle that." (unwind-protect (progn (x-setup-function-keys frame) + (dolist (face (nreverse (face-list))) + (face-spec-recalc face frame)) (x-handle-reverse-video frame parameters) (frame-set-background-mode frame t) (face-set-after-frame-default frame parameters) @@ -2145,7 +2165,7 @@ the X resource \"reverseVideo\" is present, handle that." (defun face-set-after-frame-default (frame &optional parameters) "Initialize the frame-local faces of FRAME. Calculate the face definitions using the face specs, custom theme -settings, X resources, and `face-new-frame-defaults'. +settings, X resources, and `face--new-frame-defaults'. Finally, apply any relevant face attributes found amongst the frame parameters in PARAMETERS." ;; The `reverse' is so that `default' goes first. @@ -2154,7 +2174,7 @@ frame parameters in PARAMETERS." (progn ;; Initialize faces from face spec and custom theme. (face-spec-recalc face frame) - ;; Apply attributes specified by face-new-frame-defaults + ;; Apply attributes specified by face--new-frame-defaults (internal-merge-in-global-face face frame)) ;; Don't let invalid specs prevent frame creation. (error nil))) diff --git a/lisp/frame.el b/lisp/frame.el index 378d7c8e5b..9b3d120598 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1231,7 +1231,7 @@ face specs for the new background mode." ;; during startup with -rv on the command ;; line for the initial frame, because frames ;; are not recorded in the pdump file. - (assq face (frame-face-alist frame)) + (gethash face (frame--face-hash-table)) (face-spec-match-p face (face-user-default-spec face) frame))) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index a56c7093e7..7ed2d3d08c 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1325,8 +1325,7 @@ Reinitialize the face according to the `defface' specification." ((eq (car form) 'custom-declare-face) ;; Reset the face. (let ((face-symbol (eval (nth 1 form) lexical-binding))) - (setq face-new-frame-defaults - (assq-delete-all face-symbol face-new-frame-defaults)) + (remhash face-symbol face--new-frame-defaults) (put face-symbol 'face-defface-spec nil) (put face-symbol 'face-override-spec nil)) form) diff --git a/src/frame.c b/src/frame.c index 623e4ba2cd..b105268d42 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1018,6 +1018,10 @@ make_frame (bool mini_p) rw->total_lines = FRAME_LINES (f) - (mini_p ? 1 : 0); rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); + fset_face_hash_table + (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, Qnil, false)); + if (mini_p) { mw->top_line = rw->total_lines; @@ -1326,7 +1330,7 @@ affects all frames on the same terminal device. */) { struct frame *f; struct terminal *t = NULL; - Lisp_Object frame, tem; + Lisp_Object frame; struct frame *sf = SELECTED_FRAME (); #ifdef MSDOS @@ -1408,14 +1412,16 @@ affects all frames on the same terminal device. */) store_in_alist (&parms, Qminibuffer, Qt); Fmodify_frame_parameters (frame, parms); - /* Make the frame face alist be frame-specific, so that each + /* Make the frame face hash be frame-specific, so that each frame could change its face definitions independently. */ - fset_face_alist (f, Fcopy_alist (sf->face_alist)); - /* Simple Fcopy_alist isn't enough, because we need the contents of - the vectors which are the CDRs of associations in face_alist to + fset_face_hash_table (f, Fcopy_hash_table (sf->face_hash_table)); + /* Simple copy_hash_table isn't enough, because we need the contents of + the vectors which are the values in face_hash_table to be copied as well. */ - for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem)) - XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem)))); + ptrdiff_t idx = 0; + struct Lisp_Hash_Table *table = XHASH_TABLE (f->face_hash_table); + for (idx = 0; idx < table->count; ++idx) + set_hash_value_slot (table, idx, Fcopy_sequence (HASH_VALUE (table, idx))); f->can_set_window_size = true; f->after_make_frame = true; diff --git a/src/frame.h b/src/frame.h index cad3df5ae1..a8ad011889 100644 --- a/src/frame.h +++ b/src/frame.h @@ -158,8 +158,8 @@ struct frame There are four additional elements of nil at the end, to terminate. */ Lisp_Object menu_bar_items; - /* Alist of elements (FACE-NAME . FACE-VECTOR-DATA). */ - Lisp_Object face_alist; + /* Hash table of FACE-NAME keys and FACE-VECTOR-DATA values. */ + Lisp_Object face_hash_table; /* A vector that records the entire structure of this frame's menu bar. For the format of the data, see extensive comments in xmenu.c. @@ -672,9 +672,9 @@ fset_condemned_scroll_bars (struct frame *f, Lisp_Object val) f->condemned_scroll_bars = val; } INLINE void -fset_face_alist (struct frame *f, Lisp_Object val) +fset_face_hash_table (struct frame *f, Lisp_Object val) { - f->face_alist = val; + f->face_hash_table = val; } #if defined (HAVE_WINDOW_SYSTEM) INLINE void diff --git a/src/xfaces.c b/src/xfaces.c index fed7b3336a..207f0d6a36 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -95,9 +95,10 @@ along with GNU Emacs. If not, see . */ with the symbol `face' in slot 0, and a slot for each of the face attributes mentioned above. - There is also a global face alist `Vface_new_frame_defaults'. Face - definitions from this list are used to initialize faces of newly - created frames. + There is also a global face map `Vface_new_frame_defaults', + containing conses of (FACE_ID . FACE_DEFINITION). Face definitions + from this table are used to initialize faces of newly created + frames. A face doesn't have to specify all attributes. Those not specified have a value of `unspecified'. Faces specifying all attributes but @@ -1965,13 +1966,11 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, Lisp_Object lface; if (f) - lface = assq_no_quit (face_name, f->face_alist); + lface = Fgethash (face_name, f->face_hash_table, Qnil); else - lface = assq_no_quit (face_name, Vface_new_frame_defaults); + lface = CDR (Fgethash (face_name, Vface_new_frame_defaults, Qnil)); - if (CONSP (lface)) - lface = XCDR (lface); - else if (signal_p) + if (signal_p && NILP (lface)) signal_error ("Invalid face", face_name); check_lface (lface); @@ -2870,11 +2869,6 @@ Value is a vector of face attributes. */) /* Add a global definition if there is none. */ if (NILP (global_lface)) { - global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified); - ASET (global_lface, 0, Qface); - Vface_new_frame_defaults = Fcons (Fcons (face, global_lface), - Vface_new_frame_defaults); - /* Assign the new Lisp face a unique ID. The mapping from Lisp face id to Lisp face is given by the vector lface_id_to_name. The mapping from Lisp face to Lisp face id is given by the @@ -2884,9 +2878,14 @@ Value is a vector of face attributes. */) xpalloc (lface_id_to_name, &lface_id_to_name_size, 1, MAX_FACE_ID, sizeof *lface_id_to_name); + Lisp_Object face_id = make_fixnum (next_lface_id); lface_id_to_name[next_lface_id] = face; - Fput (face, Qface, make_fixnum (next_lface_id)); + Fput (face, Qface, face_id); ++next_lface_id; + + global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified); + ASET (global_lface, 0, Qface); + Fputhash (face, Fcons (face_id, global_lface), Vface_new_frame_defaults); } else if (f == NULL) for (i = 1; i < LFACE_VECTOR_SIZE; ++i) @@ -2899,7 +2898,7 @@ Value is a vector of face attributes. */) { lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified); ASET (lface, 0, Qface); - fset_face_alist (f, Fcons (Fcons (face, lface), f->face_alist)); + Fputhash (face, lface, f->face_hash_table); } else for (i = 1; i < LFACE_VECTOR_SIZE; ++i) @@ -3060,7 +3059,7 @@ FRAME 0 means change the face on all frames, and change the default f = NULL; lface = lface_from_face_name (NULL, face, true); - /* When updating face-new-frame-defaults, we put :ignore-defface + /* When updating face--new-frame-defaults, we put :ignore-defface where the caller wants `unspecified'. This forces the frame defaults to ignore the defface value. Otherwise, the defface will take effect, which is generally not what is intended. @@ -3645,7 +3644,7 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param, /* If there are no faces yet, give up. This is the case when called from Fx_create_frame, and we do the necessary things later in face-set-after-frame-defaults. */ - if (NILP (f->face_alist)) + if (XFIXNAT (Fhash_table_count (f->face_hash_table)) == 0) return; if (EQ (param, Qforeground_color)) @@ -4311,14 +4310,13 @@ If FRAME is omitted or nil, use the selected frame. */) return i == LFACE_VECTOR_SIZE ? Qt : Qnil; } - -DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, +DEFUN ("frame--face-hash-table", Fframe_face_hash_table, Sframe_face_hash_table, 0, 1, 0, - doc: /* Return an alist of frame-local faces defined on FRAME. + doc: /* Return a hash table of frame-local faces defined on FRAME. For internal use only. */) (Lisp_Object frame) { - return decode_live_frame (frame)->face_alist; + return decode_live_frame (frame)->face_hash_table; } @@ -6835,30 +6833,32 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources, #ifdef HAVE_PDUMPER /* All the faces defined during loadup are recorded in - face-new-frame-defaults, with the last face first in the list. We - need to set next_lface_id to the next face ID number, so that any - new faces defined in this session will have face IDs different from - those defined during loadup. We also need to set up the - lface_id_to_name[] array for the faces that were defined during - loadup. */ + face-new-frame-defaults. We need to set next_lface_id to the next + face ID number, so that any new faces defined in this session will + have face IDs different from those defined during loadup. We also + need to set up the lface_id_to_name[] array for the faces that were + defined during loadup. */ void init_xfaces (void) { - if (CONSP (Vface_new_frame_defaults)) + int nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults)); + if (nfaces > 0) { /* Allocate the lface_id_to_name[] array. */ - lface_id_to_name_size = next_lface_id = - XFIXNAT (Flength (Vface_new_frame_defaults)); + lface_id_to_name_size = next_lface_id = nfaces; lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name); /* Store the faces. */ - Lisp_Object tail; - int i = next_lface_id - 1; - for (tail = Vface_new_frame_defaults; CONSP (tail); tail = XCDR (tail)) + struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults); + for (ptrdiff_t idx = 0; idx < nfaces; ++idx) { - Lisp_Object lface = XCAR (tail); - eassert (i >= 0); - lface_id_to_name[i--] = XCAR (lface); + Lisp_Object lface = HASH_KEY (table, idx); + Lisp_Object face_id = CAR (HASH_VALUE (table, idx)); + if (FIXNATP (face_id)) { + int id = XFIXNAT (face_id); + eassert (id >= 0); + lface_id_to_name[id] = lface; + } } } face_attr_sym[0] = Qface; @@ -7014,7 +7014,7 @@ syms_of_xfaces (void) defsubr (&Sinternal_copy_lisp_face); defsubr (&Sinternal_merge_in_global_face); defsubr (&Sface_font); - defsubr (&Sframe_face_alist); + defsubr (&Sframe_face_hash_table); defsubr (&Sdisplay_supports_face_attributes_p); defsubr (&Scolor_distance); defsubr (&Sinternal_set_font_selection_order); @@ -7038,9 +7038,12 @@ This variable is intended for use only by code that evaluates the "specifity" of a face specification and should be let-bound only for this purpose. */); - DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults, - doc: /* List of global face definitions (for internal use only.) */); - Vface_new_frame_defaults = Qnil; + DEFVAR_LISP ("face--new-frame-defaults", Vface_new_frame_defaults, + doc: /* Hash table of global face definitions (for internal use only.) */); + Vface_new_frame_defaults = + /* 33 entries is enough to fit all basic faces */ + make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, Qnil, false); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. commit e56ad2cb0f0cff2b7c2359bc3fa0b432dfd571f5 Author: Stefan Monnier Date: Wed Jul 21 09:09:43 2021 -0400 * doc/lispref/display.texi (Overlay Properties): Tweak further The "character after point" is not as important as point itself diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index c2ebf81f66..13d0a1b458 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1863,10 +1863,10 @@ from the buffer. @kindex keymap @r{(overlay property)} If this property is non-@code{nil}, it specifies a keymap for a portion of the text. This keymap takes precedence over most other -keymaps (@pxref{Active Keymaps}), and it is used when the character -after point is within the overlay, or would be when taking the front- -and rear-advance properties into consideration (@pxref{Managing -Overlays}). +keymaps (@pxref{Active Keymaps}), and it is used when point is within +the overlay, where the front- +and rear-advance properties define whether the boundaries are +considered as being @emph{within} or not. @item local-map @kindex local-map @r{(overlay property)} commit 3d956fd0e3d609f384509e7c81f724b5065f3be1 Author: Lars Ingebrigtsen Date: Wed Jul 21 14:22:54 2021 +0200 Remove some "is"es from previous json checkin * lisp/subr.el (json-available-p): * doc/lispref/text.texi (Parsing JSON): Fix typo in last check-in. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index a3b537ad4a..e18ba47282 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5302,7 +5302,7 @@ represents @code{@{@}}, the empty JSON object; not @code{null}, values. @defun json-available-p -This predicate returns non-@code{nil} is Emacs has been built with +This predicate returns non-@code{nil} if Emacs has been built with @acronym{JSON} support, and the library is available on the current system. @end defun diff --git a/lisp/subr.el b/lisp/subr.el index 3d66928b51..49c26cc0d3 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6312,7 +6312,7 @@ This is intended for internal use only." (internal--fill-string-single-line (apply #'format string objects))) (defun json-available-p () - "Return non-nil if Emacs is has libjansson support." + "Return non-nil if Emacs has libjansson support." (and (fboundp 'json-serialize) (condition-case nil (json-serialize t) commit cb9d82a17c78085692cdb55c31b38f00e8e6919b Author: Stefan Kangas Date: Wed Jul 21 14:01:57 2021 +0200 Factor out char_table_ref_simple for readability * src/chartab.c (char_table_ref_simple): New function... (sub_char_table_ref_and_range, char_table_ref_and_range): ...factored out from here. (bug#45550). diff --git a/src/chartab.c b/src/chartab.c index 331e8595eb..6f0bc28f31 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -62,6 +62,9 @@ typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object); static Lisp_Object uniprop_table_uncompress (Lisp_Object, int); static uniprop_decoder_t uniprop_get_decoder (Lisp_Object); +static Lisp_Object +sub_char_table_ref_and_range (Lisp_Object, int, int *, int *, + Lisp_Object, bool); /* 1 iff TABLE is a uniprop table. */ #define UNIPROP_TABLE_P(TABLE) \ @@ -247,6 +250,23 @@ char_table_ref (Lisp_Object table, int c) return val; } +static inline Lisp_Object +char_table_ref_simple (Lisp_Object table, int idx, int c, int *from, int *to, + Lisp_Object defalt, bool is_uniprop, bool is_subtable) +{ + Lisp_Object val = is_subtable ? + XSUB_CHAR_TABLE (table)->contents[idx]: + XCHAR_TABLE (table)->contents[idx]; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val)) + val = uniprop_table_uncompress (table, idx); + if (SUB_CHAR_TABLE_P (val)) + val = sub_char_table_ref_and_range (val, c, from, to, + defalt, is_uniprop); + else if (NILP (val)) + val = defalt; + return val; +} + static Lisp_Object sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp_Object defalt, bool is_uniprop) @@ -254,31 +274,18 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); int depth = tbl->depth, min_char = tbl->min_char; int chartab_idx = CHARTAB_IDX (c, depth, min_char), idx; - Lisp_Object val; - - val = tbl->contents[chartab_idx]; - if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val)) - val = uniprop_table_uncompress (table, chartab_idx); - if (SUB_CHAR_TABLE_P (val)) - val = sub_char_table_ref_and_range (val, c, from, to, defalt, is_uniprop); - else if (NILP (val)) - val = defalt; + Lisp_Object val + = char_table_ref_simple (table, chartab_idx, c, from, to, + defalt, is_uniprop, true); idx = chartab_idx; while (idx > 0 && *from < min_char + idx * chartab_chars[depth]) { - Lisp_Object this_val; - c = min_char + idx * chartab_chars[depth] - 1; idx--; - this_val = tbl->contents[idx]; - if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val)) - this_val = uniprop_table_uncompress (table, idx); - if (SUB_CHAR_TABLE_P (this_val)) - this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt, - is_uniprop); - else if (NILP (this_val)) - this_val = defalt; + Lisp_Object this_val + = char_table_ref_simple (table, idx, c, from, to, + defalt, is_uniprop, true); if (! EQ (this_val, val)) { @@ -290,17 +297,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, < chartab_chars[depth - 1]) && (c += min_char) <= *to) { - Lisp_Object this_val; - chartab_idx++; - this_val = tbl->contents[chartab_idx]; - if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val)) - this_val = uniprop_table_uncompress (table, chartab_idx); - if (SUB_CHAR_TABLE_P (this_val)) - this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt, - is_uniprop); - else if (NILP (this_val)) - this_val = defalt; + Lisp_Object this_val + = char_table_ref_simple (table, chartab_idx, c, from, to, + defalt, is_uniprop, true); + if (! EQ (this_val, val)) { *to = c - 1; @@ -321,37 +322,26 @@ Lisp_Object char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to) { struct Lisp_Char_Table *tbl = XCHAR_TABLE (table); - int chartab_idx = CHARTAB_IDX (c, 0, 0), idx; - Lisp_Object val; + int chartab_idx = CHARTAB_IDX (c, 0, 0); bool is_uniprop = UNIPROP_TABLE_P (table); - val = tbl->contents[chartab_idx]; if (*from < 0) *from = 0; if (*to < 0) *to = MAX_CHAR; - if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val)) - val = uniprop_table_uncompress (table, chartab_idx); - if (SUB_CHAR_TABLE_P (val)) - val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt, - is_uniprop); - else if (NILP (val)) - val = tbl->defalt; - idx = chartab_idx; + + Lisp_Object val + = char_table_ref_simple (table, chartab_idx, c, from, to, + tbl->defalt, is_uniprop, false); + + int idx = chartab_idx; while (*from < idx * chartab_chars[0]) { - Lisp_Object this_val; - c = idx * chartab_chars[0] - 1; idx--; - this_val = tbl->contents[idx]; - if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val)) - this_val = uniprop_table_uncompress (table, idx); - if (SUB_CHAR_TABLE_P (this_val)) - this_val = sub_char_table_ref_and_range (this_val, c, from, to, - tbl->defalt, is_uniprop); - else if (NILP (this_val)) - this_val = tbl->defalt; + Lisp_Object this_val + = char_table_ref_simple (table, idx, c, from, to, + tbl->defalt, is_uniprop, false); if (! EQ (this_val, val)) { @@ -361,18 +351,12 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to) } while (*to >= (chartab_idx + 1) * chartab_chars[0]) { - Lisp_Object this_val; - chartab_idx++; c = chartab_idx * chartab_chars[0]; - this_val = tbl->contents[chartab_idx]; - if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val)) - this_val = uniprop_table_uncompress (table, chartab_idx); - if (SUB_CHAR_TABLE_P (this_val)) - this_val = sub_char_table_ref_and_range (this_val, c, from, to, - tbl->defalt, is_uniprop); - else if (NILP (this_val)) - this_val = tbl->defalt; + Lisp_Object this_val + = char_table_ref_simple (table, chartab_idx, c, from, to, + tbl->defalt, is_uniprop, false); + if (! EQ (this_val, val)) { *to = c - 1; commit bb2d1252e6da6202ebf7015ad9615b31fe993fdc Author: Lars Ingebrigtsen Date: Wed Jul 21 13:28:17 2021 +0200 Fix final test for invalid base64url chars * src/fns.c (base64_decode_1): Fix test for invalid base64url (bug#45562). Noted by Andreas Schwab. diff --git a/src/fns.c b/src/fns.c index a178216622..7b9e3b0f7f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3955,7 +3955,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, if (c == '=') continue; - if (v1 < 0) + if (v1 == 0) return -1; value += v1 - 1; commit cdc1fab38d70f33b4b0d8da19d8474fe11f2f3dd Author: Pankaj Jangid Date: Wed Jul 21 12:15:23 2021 +0530 Fixed a typo in Gnus manual * doc/misc/gnus.texi (Washing Mail): Fixed typo diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index c9b5b2d9ff..9cdcf39ae1 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -16288,7 +16288,7 @@ cleaning up the headers. Functions that can be used include: Clear leading white space that ``helpful'' listservs have added to the headers to make them look nice. Aaah. -(Note that this function works on both the header on the body of all +(Note that this function works on both the header and the body of all messages, so it is a potentially dangerous function to use (if a body of a message contains something that looks like a header line). So rather than fix the bug, it is of course the right solution to make it commit 92923414a031471d427e84440e29fd8d7e3ea89f Author: Lars Ingebrigtsen Date: Wed Jul 21 13:15:05 2021 +0200 Fix bug-reference.el compilation warning * lisp/progmodes/bug-reference.el (bug-reference-mode): Silence a compilation warning (bug#49677). diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 755211b922..9b9c58eb1f 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -345,6 +345,7 @@ and set it if applicable." (defvar gnus-article-buffer) (defvar gnus-original-article-buffer) (defvar gnus-summary-buffer) +(defvar bug-reference-mode) (defun bug-reference--try-setup-gnus-article () (when (and bug-reference-mode ;; Only if enabled in article buffers. commit 5e385eb49dbf4f3ccf68a6670e245a309e4393c4 Author: Lars Ingebrigtsen Date: Wed Jul 21 13:12:05 2021 +0200 Restore evaluation logic in dired-guess-default * lisp/dired-x.el (dired-guess-default): Restore the `eval' bits also removed in a previous commit (bug#48071). diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 073923e09c..a7bfae759e 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -975,17 +975,20 @@ See `dired-guess-shell-alist-user'." (let* ((case-fold-search dired-guess-shell-case-fold-search) (programs (delete-dups - (seq-reduce - #'append - (mapcar #'cdr - (seq-filter (lambda (elem) - (seq-every-p - (lambda (file) - (string-match-p (car elem) file)) - files)) - (append dired-guess-shell-alist-user - dired-guess-shell-alist-default))) - nil)))) + (mapcar + (lambda (command) + (eval command `((file . ,(car files))))) + (seq-reduce + #'append + (mapcar #'cdr + (seq-filter (lambda (elem) + (seq-every-p + (lambda (file) + (string-match-p (car elem) file)) + files)) + (append dired-guess-shell-alist-user + dired-guess-shell-alist-default))) + nil))))) (if (length= programs 1) (car programs) programs))) commit bc0aca059dbfe8cd485d9591f36efb70a2a6272e Author: Lars Ingebrigtsen Date: Wed Jul 21 13:04:06 2021 +0200 Fix dired-guess-default logic after previous change * lisp/dired-x.el (dired-guess-default): Restore previous logic -- require matches for all files (bug#48071). diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 2d91b5a9e8..073923e09c 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -979,9 +979,10 @@ See `dired-guess-shell-alist-user'." #'append (mapcar #'cdr (seq-filter (lambda (elem) - (seq-some (lambda (file) - (string-match-p (car elem) file)) - files)) + (seq-every-p + (lambda (file) + (string-match-p (car elem) file)) + files)) (append dired-guess-shell-alist-user dired-guess-shell-alist-default))) nil)))) diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el index 98754b19b4..003923d60f 100644 --- a/test/lisp/dired-x-tests.el +++ b/test/lisp/dired-x-tests.el @@ -58,8 +58,9 @@ ("\\.jpe?g\\'" "xloadimage")))) (should (equal (dired-guess-default '("/tmp/foo.png")) "display")) (should (equal (dired-guess-default '("/tmp/foo.gif")) - '("display" "xloadimage" "feh"))))) - + '("display" "xloadimage" "feh"))) + (should (equal (dired-guess-default '("/tmp/foo.png" "/tmp/foo.txt")) + nil)))) (provide 'dired-x-tests) ;; dired-x-tests.el ends here commit e4f323a82a6f92af391831b83e2ebd2b91250837 Author: Lars Ingebrigtsen Date: Wed Jul 21 12:49:11 2021 +0200 Add json-available-p * doc/lispref/text.texi (Parsing JSON): Document it. * lisp/subr.el (json-available-p): New function (bug#49660). diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 6fbb475a32..a3b537ad4a 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5301,11 +5301,20 @@ represents @code{@{@}}, the empty JSON object; not @code{null}, @code{false}, or an empty array, all of which are different JSON values. +@defun json-available-p +This predicate returns non-@code{nil} is Emacs has been built with +@acronym{JSON} support, and the library is available on the current +system. +@end defun + If some Lisp object can't be represented in JSON, the serialization functions will signal an error of type @code{wrong-type-argument}. The parsing functions can also signal the following errors: @table @code +@item json-unavailable +Signaled when the parsing library isn't available. + @item json-end-of-file Signaled when encountering a premature end of the input text. diff --git a/etc/NEWS b/etc/NEWS index 49396c321d..b1db3b7c33 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2024,6 +2024,27 @@ used instead. Uses of 'json-encode-list' should be changed to call one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or 'json-encode-array' instead. +** json.c + ++++ +*** New function 'json-available-p'. +This predicate returns non-nil if Emacs is built with libjansson +support, and it is available on the current system. + ++++ +*** Native JSON functions now signal an error if libjansson is unavailable. +This affects 'json-serialize', 'json-insert', 'json-parse-srtring', +and 'json-parse-buffer'. This can happen if Emacs was compiled with +libjansson, but the DLL cannot be found and/or loaded by Emacs at run +time. Previously, Emacs would display a message and return nil in +these cases. + +*** The JSON functions 'json-serialize', 'json-insert', +'json-parse-string', and 'json-parse-buffer' now implement some of the +semantics of RFC 8259 instead of the earlier RFC 4627. In particular, +these functions now accept top-level JSON values that are neither +arrays nor objects. + ** xml.el *** XML serialization functions now reject invalid characters. @@ -3473,12 +3494,6 @@ locales. They are also available as aliases 'ebcdic-cp-*' (e.g., 'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to support these coding-systems. -** The JSON functions 'json-serialize', 'json-insert', -'json-parse-string', and 'json-parse-buffer' now implement some of the -semantics of RFC 8259 instead of the earlier RFC 4627. In particular, -these functions now accept top-level JSON values that are neither -arrays nor objects. - --- ** 'while-no-input-ignore-events' accepts more special events. The special events 'dbus-event' and 'file-notify' are now ignored in @@ -3538,14 +3553,6 @@ To turn this on, set the variable 'w32-use-native-image-API' to a non-nil value. Please report any bugs you find while using the native image API via 'M-x report-emacs-bug'. ---- -** Native JSON functions now signal an error if libjansson is unavailable. -This affects 'json-serialize', 'json-insert', 'json-parse-srtring', -and 'json-parse-buffer'. This can happen if Emacs was compiled with -libjansson, but the DLL cannot be found and/or loaded by Emacs at run -time. Previously, Emacs would display a message and return nil in -these cases. - --- ** The user option 'make-pointer-invisible' is now honored on macOS. diff --git a/lisp/subr.el b/lisp/subr.el index c7e18646bf..3d66928b51 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6311,4 +6311,12 @@ of fill.el (for example `fill-region')." This is intended for internal use only." (internal--fill-string-single-line (apply #'format string objects))) +(defun json-available-p () + "Return non-nil if Emacs is has libjansson support." + (and (fboundp 'json-serialize) + (condition-case nil + (json-serialize t) + (:success t) + (json-unavailable nil)))) + ;;; subr.el ends here commit 654ef0607075467dc3335324b127b5b9f932fa9f Author: Lars Ingebrigtsen Date: Wed Jul 21 12:33:42 2021 +0200 Mention rear-advance in relation to the keymap overlay property * doc/lispref/display.texi (Overlay Properties): Mention the effect of REAR-ADVANCE (bug#459). diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 3336338087..c2ebf81f66 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1861,9 +1861,12 @@ from the buffer. @item keymap @cindex keymap of character (and overlays) @kindex keymap @r{(overlay property)} -If this property is non-@code{nil}, it specifies a keymap for a portion of the -text. This keymap is used when the character after point is within the -overlay, and takes precedence over most other keymaps. @xref{Active Keymaps}. +If this property is non-@code{nil}, it specifies a keymap for a +portion of the text. This keymap takes precedence over most other +keymaps (@pxref{Active Keymaps}), and it is used when the character +after point is within the overlay, or would be when taking the front- +and rear-advance properties into consideration (@pxref{Managing +Overlays}). @item local-map @kindex local-map @r{(overlay property)} commit 070c80ee06664c90fb9c96a1b9c89f7b844ae712 Author: Mattias Engdegård Date: Wed Jul 21 10:54:43 2021 +0200 Fix mistake in `quote` optimiser Found by Pip Cet. * lisp/emacs-lisp/byte-opt.el (byte-optimize-quote): Fix mistake that made this optimiser ineffective at removing quoting of nil, t, and keywords. The only obvious consequence is that we no longer need... (byte-optimize-form): ...a 'nil => nil normalising step here; remove. (byte-optimize-form-code-walker): Make the compiler warn about (quote). diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c9c0ac0045..341643c7d1 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -414,7 +414,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") form))) (t form))) (`(quote . ,v) - (if (cdr v) + (if (or (not v) (cdr v)) (byte-compile-warn "malformed quote form: `%s'" (prin1-to-string form))) ;; Map (quote nil) to nil to simplify optimizer logic. @@ -667,8 +667,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (byte-compile-log " %s\t==>\t%s" old new) (setq form new) (not (eq new old)))))))) - ;; Normalise (quote nil) to nil, for a single representation of constant nil. - (and (not (equal form '(quote nil))) form)) + form) (defun byte-optimize-let-form (head form for-effect) ;; Recursively enter the optimizer for the bindings and body @@ -1077,7 +1076,7 @@ See Info node `(elisp) Integer Basics'." (defun byte-optimize-quote (form) (if (or (consp (nth 1 form)) (and (symbolp (nth 1 form)) - (not (macroexp--const-symbol-p form)))) + (not (macroexp--const-symbol-p (nth 1 form))))) form (nth 1 form))) commit 1b251ed4e8550c889d17fe7d88f58aa2fbc95fe0 Author: Juri Linkov Date: Tue Jul 20 22:53:06 2021 +0300 * lisp/button.el (button-map): Bind [follow-link] to 'mouse-face' (bug#49626) diff --git a/lisp/button.el b/lisp/button.el index 69d70540c0..74dfb5d541 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -61,6 +61,7 @@ ;; might get converted to ^M when building loaddefs.el (define-key map [(control ?m)] 'push-button) (define-key map [mouse-2] 'push-button) + (define-key map [follow-link] 'mouse-face) ;; FIXME: You'd think that for keymaps coming from text-properties on the ;; mode-line or header-line, the `mode-line' or `header-line' prefix ;; shouldn't be necessary! commit f9d74408148e50eb287d6bf784cddbdc239d9669 Author: Mattias Engdegård Date: Tue Jul 20 19:32:11 2021 +0200 ; * lisp/emacs-lisp/byte-opt.el (byte-optimize-eq): Fix last change. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 7ed04b32e9..c9c0ac0045 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -970,10 +970,9 @@ See Info node `(elisp) Integer Basics'." form))) (defun byte-optimize-eq (form) - (byte-optimize-binary-predicate - (pcase (cdr form) - ((or `(,x nil) `(nil ,x)) `(not ,x)) - (_ form)))) + (pcase (cdr form) + ((or `(,x nil) `(nil ,x)) `(not ,x)) + (_ (byte-optimize-binary-predicate form)))) (defun byte-optimize-member (form) ;; Replace `member' or `memql' with `memq' if the first arg is a symbol, commit 46d7d44894843bf30e9bc84473195c6ab892b752 Author: Mattias Engdegård Date: Tue Jul 20 15:46:32 2021 +0200 Strength-reduce (eq X nil) to (not X) * lisp/emacs-lisp/byte-opt.el (byte-optimize-eq): New optimisation, which results in better test and branch code generation where it applies. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 2fff0bd4a5..7ed04b32e9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -969,6 +969,12 @@ See Info node `(elisp) Integer Basics'." ;; Arity errors reported elsewhere. form))) +(defun byte-optimize-eq (form) + (byte-optimize-binary-predicate + (pcase (cdr form) + ((or `(,x nil) `(nil ,x)) `(not ,x)) + (_ form)))) + (defun byte-optimize-member (form) ;; Replace `member' or `memql' with `memq' if the first arg is a symbol, ;; or the second arg is a list of symbols. Same with fixnums. @@ -1056,7 +1062,7 @@ See Info node `(elisp) Integer Basics'." (put 'min 'byte-optimizer #'byte-optimize-min-max) (put '= 'byte-optimizer #'byte-optimize-binary-predicate) -(put 'eq 'byte-optimizer #'byte-optimize-binary-predicate) +(put 'eq 'byte-optimizer #'byte-optimize-eq) (put 'eql 'byte-optimizer #'byte-optimize-equal) (put 'equal 'byte-optimizer #'byte-optimize-equal) (put 'string= 'byte-optimizer #'byte-optimize-binary-predicate) commit 51a86b6a0504d580d3e10efe41abf3ae42c90711 Author: Mattias Engdegård Date: Tue Jul 20 17:23:11 2021 +0200 Count (not X) as a switch condition * lisp/emacs-lisp/bytecomp.el (byte-compile--cond-switch-prefix): Treat (not VAR) and (null VAR) as (eq VAR nil) when computing the extent of switch ops. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6970c8a505..2968f1af5d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4340,6 +4340,16 @@ Return (TAIL VAR TEST CASES), where: (push value keys) (push (cons (list value) (or body '(t))) cases)) t)))) + ;; Treat (not X) as (eq X nil). + (`((,(or 'not 'null) ,(and var (pred symbolp))) . ,body) + (and (or (eq var switch-var) (not switch-var)) + (progn + (setq switch-var var) + (setq switch-test 'eq) + (unless (memq nil keys) + (push nil keys) + (push (cons (list nil) (or body '(t))) cases)) + t))) (`((,(and fn (or 'memq 'memql 'member)) ,var ,expr) . ,body) (and (symbolp var) (or (eq var switch-var) (not switch-var)) commit 0c58796a2224e9b5d97a07033998099609150571 Author: Michael Albinus Date: Tue Jul 20 18:44:51 2021 +0200 * lisp/shadowfile.el (shadow-homedir): Add slash. (shadow-contract-file-name): Use it. Bug#49596. diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index ec3a27b991..f67b0b9b39 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -128,7 +128,7 @@ Default: ~/.emacs.d/shadow_todo" (defvar shadow-system-name (concat "/" (system-name) ":") "The identification for local files on this machine.") -(defvar shadow-homedir "~" +(defvar shadow-homedir "~/" "Your home directory on this machine.") ;;; @@ -352,15 +352,16 @@ Will return the name bare if it is a local file." (defun shadow-contract-file-name (file) "Simplify FILE. -Do so by replacing (when possible) home directory with ~, and hostname -with cluster name that includes it. Filename should be absolute and -true." +Do so by replacing (when possible) home directory with ~/, and +hostname with cluster name that includes it. Filename should be +absolute and true." (let* ((hup (shadow-parse-name file)) (homedir (if (shadow-local-file hup) shadow-homedir (file-name-as-directory (file-local-name - (expand-file-name (shadow-make-fullname hup nil "~")))))) + (expand-file-name + (shadow-make-fullname hup nil shadow-homedir)))))) (suffix (shadow-suffix homedir (tramp-file-name-localname hup))) (cluster (shadow-site-cluster (shadow-make-fullname hup nil "")))) (when cluster @@ -369,7 +370,7 @@ true." (shadow-make-fullname hup nil (if suffix - (concat "~/" suffix) + (concat shadow-homedir suffix) (tramp-file-name-localname hup))))) (defun shadow-same-site (pattern file) commit 97fd31fec7a760cf6f01aa0d1822b205018e07d3 Author: Eli Zaretskii Date: Tue Jul 20 19:00:53 2021 +0300 ; * etc/NEWS: Announce the change in json.c behavior on MS-Windows. diff --git a/etc/NEWS b/etc/NEWS index 8fa43b83b5..49396c321d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3538,6 +3538,14 @@ To turn this on, set the variable 'w32-use-native-image-API' to a non-nil value. Please report any bugs you find while using the native image API via 'M-x report-emacs-bug'. +--- +** Native JSON functions now signal an error if libjansson is unavailable. +This affects 'json-serialize', 'json-insert', 'json-parse-srtring', +and 'json-parse-buffer'. This can happen if Emacs was compiled with +libjansson, but the DLL cannot be found and/or loaded by Emacs at run +time. Previously, Emacs would display a message and return nil in +these cases. + --- ** The user option 'make-pointer-invisible' is now honored on macOS. commit b575e44cbffbbfb8e09e26b94701f5bec65c9dc0 Author: Eli Zaretskii Date: Tue Jul 20 18:37:40 2021 +0300 Fix documentation of a recent changeset * lisp/autorevert.el (auto-revert-mode): * lisp/files.el (revert-buffer): Doc fix. (Bug#49661) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index f8fd92d02b..9197eadf22 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -391,10 +391,9 @@ disk changes. When a buffer is reverted, a message is generated. This can be suppressed by setting `auto-revert-verbose' to nil. -Reverting may also break markers in the buffer. To avoid that -you may set `revert-buffer-insert-file-contents-function' to the -slower function `revert-buffer-insert-file-contents-delicately'. -See its description for details. +Reverting can sometimes fail to preserve all the markers in the buffer. +To avoid that, set `revert-buffer-insert-file-contents-function' to +the slower function `revert-buffer-insert-file-contents-delicately'. Use `global-auto-revert-mode' to automatically revert all buffers. Use `auto-revert-tail-mode' if you know that the file will only grow diff --git a/lisp/files.el b/lisp/files.el index 01b8bdf5ff..0606ed6482 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6278,10 +6278,6 @@ This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. -Reverting a buffer will try to preserve markers in the buffer, -but for better results see `revert-buffer-with-fine-grain'. For -details see the Info node `(elisp)Reverting'. - This command also implements an interface for special buffers that contain text that doesn't come from a file, but reflects some other data instead (e.g. Dired buffers, `buffer-list' @@ -6307,7 +6303,12 @@ This function binds `revert-buffer-in-progress-p' non-nil while it operates. This function calls the function that `revert-buffer-function' specifies to do the work, with arguments IGNORE-AUTO and NOCONFIRM. The default function runs the hooks `before-revert-hook' and -`after-revert-hook'." +`after-revert-hook' + +Reverting a buffer will try to preserve markers in the buffer, +but it cannot always preserve all of them. For better results, +use `revert-buffer-with-fine-grain', which tries harder to +preserve markers and overlays, at the price of being slower." ;; I admit it's odd to reverse the sense of the prefix argument, but ;; there is a lot of code out there that assumes that the first ;; argument should be t to avoid consulting the auto-save file, and commit 6bea195db5ba93380148723f6b7290187e94437e Author: Michael Albinus Date: Tue Jul 20 17:28:29 2021 +0200 Fix Bug#49636 * test/lisp/net/tramp-tests.el (tramp-test39-make-lock-file-name): Let-bind `auto-save-default'. (Bug#49636) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index be4b4279b4..b3a00215ac 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5771,6 +5771,7 @@ Use direct async.") (append (and (tramp--test-fuse-p) '(tramp-fuse-unmount)) tramp-cleanup-connection-hook)) + auto-save-default noninteractive) (unwind-protect commit 61c1522ddedc45d85804ff2786bd301e9b487b32 Author: Konstantin Kharlamov Date: Tue Jul 20 16:38:55 2021 +0200 Improve auto-revert-mode and revert-buffer doc strings * lisp/autorevert.el (auto-revert-mode): * lisp/files.el (revert-buffer): Mention that there is revert-buffer-with-fine-grain that is better suited for markers preservation (bug#49661). diff --git a/lisp/autorevert.el b/lisp/autorevert.el index edd4c7e5e4..f8fd92d02b 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -391,6 +391,11 @@ disk changes. When a buffer is reverted, a message is generated. This can be suppressed by setting `auto-revert-verbose' to nil. +Reverting may also break markers in the buffer. To avoid that +you may set `revert-buffer-insert-file-contents-function' to the +slower function `revert-buffer-insert-file-contents-delicately'. +See its description for details. + Use `global-auto-revert-mode' to automatically revert all buffers. Use `auto-revert-tail-mode' if you know that the file will only grow without being changed in the part that is already in the buffer." diff --git a/lisp/files.el b/lisp/files.el index c265f33550..01b8bdf5ff 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6278,8 +6278,9 @@ This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. -Reverting a buffer will try to preserve markers in the buffer; -see the Info node `(elisp)Reverting' for details. +Reverting a buffer will try to preserve markers in the buffer, +but for better results see `revert-buffer-with-fine-grain'. For +details see the Info node `(elisp)Reverting'. This command also implements an interface for special buffers that contain text that doesn't come from a file, but reflects commit b4fabb316dfe59c75525cd37eaf87020582a9d12 Author: jakanakaevangeli Date: Tue Jul 20 16:31:24 2021 +0200 Make `kill-all-local-variables' also remove lambda from hooks * src/buffer.c (reset_buffer_local_variables): Also remove non-symbol elements from hook variables (bug#46407). diff --git a/etc/NEWS b/etc/NEWS index df09d81bcf..8fa43b83b5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2829,6 +2829,14 @@ This is to keep the same behavior as Eshell. * Incompatible Lisp Changes in Emacs 28.1 +--- +** 'kill-all-local-variables' has changed how it handles non-symbol hooks. +The function is documented to eliminated all buffer-local bindings +except variables with a 'permanent-local' property, or hooks that +have elements with a 'permanent-local-hook' property. In addition, it +would also keep lambda expressions in hooks sometimes. The latter has +now been changed: The function will now also remove these. + --- ** Some floating-point numbers are now handled differently by the Lisp reader. In previous versions of Emacs, numbers with a trailing dot and an exponent diff --git a/src/buffer.c b/src/buffer.c index 335523de60..b177c5eaa7 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1084,12 +1084,12 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too) for (newlist = Qnil; CONSP (list); list = XCDR (list)) { Lisp_Object elt = XCAR (list); - /* Preserve element ELT if it's t, - if it is a function with a `permanent-local-hook' property, - or if it's not a symbol. */ - if (! SYMBOLP (elt) - || EQ (elt, Qt) - || !NILP (Fget (elt, Qpermanent_local_hook))) + /* Preserve element ELT if it's t, or if it is a + function with a `permanent-local-hook' + property. */ + if (EQ (elt, Qt) + || (SYMBOLP (elt) + && !NILP (Fget (elt, Qpermanent_local_hook)))) newlist = Fcons (elt, newlist); } newlist = Fnreverse (newlist); commit c175ad52faae49a10a7c04c79a7ca88d68c551b4 Author: Lars Ingebrigtsen Date: Tue Jul 20 16:16:09 2021 +0200 Make dired-guess-default return all matching programs * lisp/dired-x.el (dired-guess-default): Return all matching programs (bug#48071). diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 8d99d1a21c..2d91b5a9e8 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -972,38 +972,22 @@ REGEXP is matched case-sensitively." (defun dired-guess-default (files) "Return a shell command, or a list of commands, appropriate for FILES. See `dired-guess-shell-alist-user'." - (let* ((case-fold-search dired-guess-shell-case-fold-search) - ;; Prepend the user's alist to the default alist. - (alist (append dired-guess-shell-alist-user - dired-guess-shell-alist-default)) - (file (car files)) - (flist (cdr files)) - elt regexp cmds) - - ;; Find the first match in the alist for first file in FILES. - (while alist - (setq elt (car alist) - regexp (car elt) - alist (cdr alist)) - (if (string-match-p regexp file) - (setq cmds (cdr elt) - alist nil))) - - ;; If more than one file, see if all of FILES match regular expression. - (while (and flist - (string-match-p regexp (car flist))) - (setq flist (cdr flist))) - - ;; If flist is still non-nil, then do not guess since this means that not - ;; all the files in FILES were matched by the regexp. - (setq cmds (and (not flist) cmds)) - - ;; Return commands or nil if flist is still non-nil. - ;; Evaluate the commands in order that any logical testing will be done. - (if (cdr cmds) - (delete-dups (mapcar (lambda (cmd) (eval cmd `((file . ,file)))) cmds)) - (eval (car cmds) `((file . ,file)))))) ; single command + (programs + (delete-dups + (seq-reduce + #'append + (mapcar #'cdr + (seq-filter (lambda (elem) + (seq-some (lambda (file) + (string-match-p (car elem) file)) + files)) + (append dired-guess-shell-alist-user + dired-guess-shell-alist-default))) + nil)))) + (if (length= programs 1) + (car programs) + programs))) (defun dired-guess-shell-command (prompt files) "Ask user with PROMPT for a shell command, guessing a default from FILES." diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el index 5b51c997e3..98754b19b4 100644 --- a/test/lisp/dired-x-tests.el +++ b/test/lisp/dired-x-tests.el @@ -49,5 +49,17 @@ (sort (dired-get-marked-files 'local) #'string<)))) (delete-directory dir 'recursive)))) +(ert-deftest dired-guess-default () + (let ((dired-guess-shell-alist-user nil) + (dired-guess-shell-alist-default + '(("\\.png\\'" "display") + ("\\.gif\\'" "display" "xloadimage") + ("\\.gif\\'" "feh") + ("\\.jpe?g\\'" "xloadimage")))) + (should (equal (dired-guess-default '("/tmp/foo.png")) "display")) + (should (equal (dired-guess-default '("/tmp/foo.gif")) + '("display" "xloadimage" "feh"))))) + + (provide 'dired-x-tests) ;; dired-x-tests.el ends here commit 606b783acb3388249c38264f8e37e08af832e1ea Author: Ioannis Kappas Date: Tue Jul 20 15:53:34 2021 +0200 Allow installing packages with DOS line endings * lisp/emacs-lisp/package.el (package-install-from-buffer): Allow installing files with different line ending conventions (Unix, DOS and Macos) (bug#48137). diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 6bbd4c9976..f1daa8d124 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2195,8 +2195,24 @@ Downloads and installs required packages as needed." ((derived-mode-p 'tar-mode) (package-tar-file-info)) (t - (save-excursion - (package-buffer-info))))) + ;; Package headers should be parsed from decoded text + ;; (see Bug#48137) where possible. + (if (and (eq buffer-file-coding-system 'no-conversion) + buffer-file-name) + (let* ((package-buffer (current-buffer)) + (decoding-system + (car (find-operation-coding-system + 'insert-file-contents + (cons buffer-file-name + package-buffer))))) + (with-temp-buffer + (insert-buffer-substring package-buffer) + (decode-coding-region (point-min) (point-max) + decoding-system) + (package-buffer-info))) + + (save-excursion + (package-buffer-info)))))) (name (package-desc-name pkg-desc))) ;; Download and install the dependencies. (let* ((requires (package-desc-reqs pkg-desc)) @@ -2222,6 +2238,7 @@ directory." (setq default-directory file) (dired-mode)) (insert-file-contents-literally file) + (set-visited-file-name file) (when (string-match "\\.tar\\'" file) (tar-mode))) (package-install-from-buffer))) diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 67d647d3b9..2943579955 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -263,6 +263,74 @@ Must called from within a `tar-mode' buffer." (should (file-exists-p autoloads-file)) (should-not (get-file-buffer autoloads-file))))) +(ert-deftest package-test-install-file () + "Install files with `package-install-file'." + (with-package-test (:basedir (ert-resource-directory)) + (package-initialize) + (let* ((pkg-el "simple-single-1.3.el") + (source-file (expand-file-name pkg-el (ert-resource-directory)))) + (should-not (package-installed-p 'simple-single)) + (package-install-file source-file) + (should (package-installed-p 'simple-single)) + (package-delete (cadr (assq 'simple-single package-alist))) + (should-not (package-installed-p 'simple-single))) + + (let* ((pkg-el "multi-file-0.2.3.tar") + (source-file (expand-file-name pkg-el (ert-resource-directory)))) + (package-initialize) + (should-not (package-installed-p 'multie-file)) + (package-install-file source-file) + (should (package-installed-p 'multi-file)) + (package-delete (cadr (assq 'multi-file package-alist)))) + )) + +(ert-deftest package-test-install-file-EOLs () + "Install same file multiple time with `package-install-file' +but with a different end of line convention (bug#48137)." + (with-package-test (:basedir (ert-resource-directory)) + (package-initialize) + (let* ((pkg-el "simple-single-1.3.el") + (source-file (expand-file-name pkg-el (ert-resource-directory)))) + + (with-temp-buffer + (insert-file-contents source-file) + + (let (hashes) + (dolist (coding '(unix dos mac) hashes) + (let* ((eol-file (expand-file-name pkg-el package-test-user-dir))) + ;; save package with this EOL convention. + (set-buffer-file-coding-system coding) + (write-region (point-min) (point-max) eol-file) + + (should-not (package-installed-p 'simple-single)) + (package-install-file eol-file) + (should (package-installed-p 'simple-single)) + + ;; check the package file has been installed unmodified. + (let ((eol-hash (with-temp-buffer + (insert-file-contents-literally eol-file) + (buffer-hash)))) + ;; also perform an additional check that the package + ;; file created with this EOL convention is different + ;; than all the others created so far. + (should-not (member eol-hash hashes)) + (setq hashes (cons eol-hash hashes)) + + (let* ((descr (cadr (assq 'simple-single package-alist))) + (pkg-dir (package-desc-dir descr)) + (dest-file (expand-file-name "simple-single.el" pkg-dir )) + (dest-hash (with-temp-buffer + (insert-file-contents-literally dest-file) + (buffer-hash)))) + + (should (string= dest-hash eol-hash)))) + + (package-delete (cadr (assq 'simple-single package-alist))) + (should-not (package-installed-p 'simple-single)) + (delete-file eol-file) + (should-not (file-exists-p eol-file)) + ))))))) + (ert-deftest package-test-install-dependency () "Install a package which includes a dependency." (with-package-test () commit aa8859d0cb94358cf81d3811953876261512b7eb Author: Lars Ingebrigtsen Date: Tue Jul 20 14:47:07 2021 +0200 Signal an error in json.c function if not available * src/json.c (Fjson_serialize, Fjson_insert) (Fjson_parse_string, Fjson_parse_buffer, syms_of_json): Signal `json-unavailable' if jansson isn't available (bug#48228). diff --git a/src/json.c b/src/json.c index 3f1d27ad7f..b0779b912a 100644 --- a/src/json.c +++ b/src/json.c @@ -595,10 +595,8 @@ usage: (json-serialize OBJECT &rest ARGS) */) Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); } if (!json_initialized) - { - message1 ("jansson library not found"); - return Qnil; - } + Fsignal (Qjson_unavailable, + list1 (build_unibyte_string ("jansson library not found"))); #endif struct json_configuration conf = @@ -706,10 +704,8 @@ usage: (json-insert OBJECT &rest ARGS) */) Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); } if (!json_initialized) - { - message1 ("jansson library not found"); - return Qnil; - } + Fsignal (Qjson_unavailable, + list1 (build_unibyte_string ("jansson library not found"))); #endif struct json_configuration conf = @@ -965,10 +961,8 @@ usage: (json-parse-string STRING &rest ARGS) */) Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); } if (!json_initialized) - { - message1 ("jansson library not found"); - return Qnil; - } + Fsignal (Qjson_unavailable, + list1 (build_unibyte_string ("jansson library not found"))); #endif Lisp_Object string = args[0]; @@ -1064,10 +1058,8 @@ usage: (json-parse-buffer &rest args) */) Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); } if (!json_initialized) - { - message1 ("jansson library not found"); - return Qnil; - } + Fsignal (Qjson_unavailable, + list1 (build_unibyte_string ("jansson library not found"))); #endif struct json_configuration conf = @@ -1129,6 +1121,7 @@ syms_of_json (void) DEFSYM (Qjson_end_of_file, "json-end-of-file"); DEFSYM (Qjson_trailing_content, "json-trailing-content"); DEFSYM (Qjson_object_too_deep, "json-object-too-deep"); + DEFSYM (Qjson_unavailable, "json-unavailable"); define_error (Qjson_error, "generic JSON error", Qerror); define_error (Qjson_out_of_memory, "not enough memory for creating JSON object", Qjson_error); commit 7edbcb3648e9d08a4ccc291f672f831b4f07eb5c Author: Miha Rihtaršič Date: Tue Jul 20 14:36:45 2021 +0200 Quit minibuffers without aborting kmacros * doc/lispref/commands.texi (Quitting): Document `minibuffer-quit' (Recursive Editing): Document throwing of function values to `exit'. * doc/lispref/errors.texi (Standard Errors): Document `minibuffer-quit' * lisp/minibuffer.el (minibuffer-quit-recursive-edit): New function. * lisp/simple.el (minibuffer-error-function): Do not abort keyboard macro execution if is minibuffer-quit is signaled (bug#48603). * src/data.c (syms_of_data): New error symbol `minibuffer-quit' * src/keyboard.c (recursive_edit_1): Implement throwing of function values to `exit`. In that case, the function will be called without arguments before returning from the command loop. (cmd_error): (Fcommand_error_default_function): Do not abort keyboard macro execution if minibuffer-quit is signaled. (command_loop_2): New argument HANDLERS. * src/macros.c (Fexecute_kbd_macro): Use command_loop_2 instead of command_loop_1. * src/minibuf.c (Fabort_minibuffers): Use it. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index f30419c3ee..b4a8b733a0 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -3381,6 +3381,12 @@ nil)}. This is the same thing that quitting does. (See @code{signal} in @ref{Errors}.) @end deffn + To quit without aborting a keyboard macro definition or execution, +you can signal the @code{minibuffer-quit} condition. This has almost +the same effect as the @code{quit} condition except that the error +handling in the command loop handles it without exiting keyboard macro +definition or execution. + You can specify a character other than @kbd{C-g} to use for quitting. See the function @code{set-input-mode} in @ref{Input Modes}. @@ -3565,12 +3571,14 @@ commands. @code{recursive-edit}. This function contains the command loop; it also contains a call to @code{catch} with tag @code{exit}, which makes it possible to exit the recursive editing level by throwing to @code{exit} -(@pxref{Catch and Throw}). If you throw a value other than @code{t}, -then @code{recursive-edit} returns normally to the function that called -it. The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this. +(@pxref{Catch and Throw}). If you throw a @code{nil} value, then +@code{recursive-edit} returns normally to the function that called it. +The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this. Throwing a @code{t} value causes @code{recursive-edit} to quit, so that control returns to the command loop one level up. This is called @dfn{aborting}, and is done by @kbd{C-]} (@code{abort-recursive-edit}). +You can also throw a function value. In that case, +@code{recursive-edit} will call it without arguments before returning. Most applications should not use recursive editing, except as part of using the minibuffer. Usually it is more convenient for the user if you diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index fb393b951f..f848218e26 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -20,8 +20,9 @@ the errors in accessing files have the condition @code{file-error}. If we do not say here that a certain error symbol has additional error conditions, that means it has none. - As a special exception, the error symbol @code{quit} does not have the -condition @code{error}, because quitting is not considered an error. + As a special exception, the error symbols @code{quit} and +@code{minibuffer-quit} don't have the condition @code{error}, because +quitting is not considered an error. Most of these error symbols are defined in C (mainly @file{data.c}), but some are defined in Lisp. For example, the file @file{userlock.el} @@ -40,6 +41,10 @@ The message is @samp{error}. @xref{Errors}. @item quit The message is @samp{Quit}. @xref{Quitting}. +@item minibuffer-quit +The message is @samp{Quit}. This is a subcategory of @code{quit}. +@xref{Quitting}. + @item args-out-of-range The message is @samp{Args out of range}. This happens when trying to access an element beyond the range of a sequence, buffer, or other diff --git a/etc/NEWS b/etc/NEWS index 953c952d05..df09d81bcf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2682,6 +2682,15 @@ also keep the type information of their arguments. Use the --- *** New face 'perl-heredoc', used for heredoc elements. ++++ +** A function can now be thrown to the 'exit' label in addition to t or nil. +The command loop will call it with zero arguments before returning. + ++++ +** New error symbol 'minibuffer-quit'. +Signaling it has almost the same effect as 'quit' except that it +doesn't cause keyboard macro termination. + --- *** The command 'cperl-set-style' offers the new value "PBP". This value customizes Emacs to use the style recommended in Damian diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 813ce14c59..1578ab8e1e 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2328,6 +2328,15 @@ variables.") (setq deactivate-mark nil) (throw 'exit nil)) +(defun minibuffer-quit-recursive-edit () + "Quit the command that requested this recursive edit without error. +Like `abort-recursive-edit' without aborting keyboard macro +execution." + ;; See Info node `(elisp)Recursive Editing' for an explanation of + ;; throwing a function to `exit'. + (throw 'exit (lambda () + (signal 'minibuffer-quit nil)))) + (defun self-insert-and-exit () "Terminate minibuffer input." (interactive) diff --git a/lisp/simple.el b/lisp/simple.el index 5741c24eb7..1a49fe2425 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2879,8 +2879,10 @@ Go to the history element by the absolute history position HIST-POS." The same as `command-error-default-function' but display error messages at the end of the minibuffer using `minibuffer-message' to not obscure the minibuffer contents." - (discard-input) - (ding) + (if (memq 'minibuffer-quit (get (car data) 'error-conditions)) + (ding t) + (discard-input) + (ding)) (let ((string (error-message-string data))) ;; If we know from where the error was signaled, show it in ;; *Messages*. diff --git a/src/data.c b/src/data.c index 9adfafacaa..ffca7e7535 100644 --- a/src/data.c +++ b/src/data.c @@ -3901,6 +3901,7 @@ syms_of_data (void) DEFSYM (Qerror, "error"); DEFSYM (Quser_error, "user-error"); DEFSYM (Qquit, "quit"); + DEFSYM (Qminibuffer_quit, "minibuffer-quit"); DEFSYM (Qwrong_length_argument, "wrong-length-argument"); DEFSYM (Qwrong_type_argument, "wrong-type-argument"); DEFSYM (Qargs_out_of_range, "args-out-of-range"); @@ -3973,6 +3974,7 @@ syms_of_data (void) Fput (sym, Qerror_message, build_pure_c_string (msg)) PUT_ERROR (Qquit, Qnil, "Quit"); + PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit"); PUT_ERROR (Quser_error, error_tail, ""); PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument"); diff --git a/src/keyboard.c b/src/keyboard.c index 77d6bbba62..db93468659 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -725,6 +725,9 @@ recursive_edit_1 (void) if (STRINGP (val)) xsignal1 (Qerror, val); + if (FUNCTIONP (val)) + call0 (val); + return unbind_to (count, Qnil); } @@ -921,6 +924,7 @@ static Lisp_Object cmd_error (Lisp_Object data) { Lisp_Object old_level, old_length; + Lisp_Object conditions; char macroerror[sizeof "After..kbd macro iterations: " + INT_STRLEN_BOUND (EMACS_INT)]; @@ -940,10 +944,15 @@ cmd_error (Lisp_Object data) else *macroerror = 0; + conditions = Fget (XCAR (data), Qerror_conditions); + if (NILP (Fmemq (Qminibuffer_quit, conditions))) + { + Vexecuting_kbd_macro = Qnil; + executing_kbd_macro = Qnil; + } + Vstandard_output = Qt; Vstandard_input = Qt; - Vexecuting_kbd_macro = Qnil; - executing_kbd_macro = Qnil; kset_prefix_arg (current_kboard, Qnil); kset_last_prefix_arg (current_kboard, Qnil); cancel_echoing (); @@ -998,6 +1007,7 @@ Default value of `command-error-function'. */) (Lisp_Object data, Lisp_Object context, Lisp_Object signal) { struct frame *sf = SELECTED_FRAME (); + Lisp_Object conditions; CHECK_STRING (context); @@ -1024,17 +1034,27 @@ Default value of `command-error-function'. */) } else { + conditions = Fget (XCAR (data), Qerror_conditions); + clear_message (1, 0); - Fdiscard_input (); message_log_maybe_newline (); - bitch_at_user (); + + if (!NILP (Fmemq (Qminibuffer_quit, conditions))) + { + Fding (Qt); + } + else + { + Fdiscard_input (); + bitch_at_user (); + } print_error_message (data, Qt, SSDATA (context), signal); } return Qnil; } -static Lisp_Object command_loop_2 (Lisp_Object); +static Lisp_Object command_loop_1 (void); static Lisp_Object top_level_1 (Lisp_Object); /* Entry to editor-command-loop. @@ -1062,7 +1082,7 @@ command_loop (void) if (command_loop_level > 0 || minibuf_level > 0) { Lisp_Object val; - val = internal_catch (Qexit, command_loop_2, Qnil); + val = internal_catch (Qexit, command_loop_2, Qerror); executing_kbd_macro = Qnil; return val; } @@ -1070,7 +1090,7 @@ command_loop (void) while (1) { internal_catch (Qtop_level, top_level_1, Qnil); - internal_catch (Qtop_level, command_loop_2, Qnil); + internal_catch (Qtop_level, command_loop_2, Qerror); executing_kbd_macro = Qnil; /* End of file in -batch run causes exit here. */ @@ -1083,15 +1103,16 @@ command_loop (void) editing loop, and reenter the editing loop. When there is an error, cmd_error runs and returns a non-nil value to us. A value of nil means that command_loop_1 itself - returned due to end of file (or end of kbd macro). */ + returned due to end of file (or end of kbd macro). HANDLERS is a + list of condition names, passed to internal_condition_case. */ -static Lisp_Object -command_loop_2 (Lisp_Object ignore) +Lisp_Object +command_loop_2 (Lisp_Object handlers) { register Lisp_Object val; do - val = internal_condition_case (command_loop_1, Qerror, cmd_error); + val = internal_condition_case (command_loop_1, handlers, cmd_error); while (!NILP (val)); return Qnil; @@ -1234,7 +1255,7 @@ static int read_key_sequence (Lisp_Object *, Lisp_Object, bool, bool, bool, bool); static void adjust_point_for_property (ptrdiff_t, bool); -Lisp_Object +static Lisp_Object command_loop_1 (void) { modiff_count prev_modiff = 0; diff --git a/src/lisp.h b/src/lisp.h index 1795b9d811..b3f1dc16b1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4417,7 +4417,7 @@ extern bool detect_input_pending_ignore_squeezables (void); extern bool detect_input_pending_run_timers (bool); extern void safe_run_hooks (Lisp_Object); extern void cmd_error_internal (Lisp_Object, const char *); -extern Lisp_Object command_loop_1 (void); +extern Lisp_Object command_loop_2 (Lisp_Object); extern Lisp_Object read_menu_command (void); extern Lisp_Object recursive_edit_1 (void); extern void record_auto_save (void); diff --git a/src/macros.c b/src/macros.c index 60d0766a75..0752a5bb6f 100644 --- a/src/macros.c +++ b/src/macros.c @@ -324,7 +324,7 @@ buffer before the macro is executed. */) break; } - command_loop_1 (); + command_loop_2 (list1 (Qminibuffer_quit)); executing_kbd_macro_iterations = ++success_count; diff --git a/src/minibuf.c b/src/minibuf.c index 1b842b7721..0f4349e70b 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -496,7 +496,7 @@ confirm the aborting of the current minibuffer and all contained ones. */) } } else - Fthrow (Qexit, Qt); + CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit")); return Qnil; } commit 557c59591cb03729c7ab56719e5ed87a1f06d435 Author: Kenichi Handa Date: Tue Jul 20 14:22:53 2021 +0200 Fix problem with certain fonts in ftfont_shape_by_flt * src/ftfont.c (ftfont_shape_by_flt): Fix problem with unusual OTF tables in fonts (bug#49066). diff --git a/src/ftfont.c b/src/ftfont.c index 0603dd9ce6..12d0d72d27 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -2798,10 +2798,31 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, if (gstring.used > LGSTRING_GLYPH_LEN (lgstring)) return Qnil; + + /* mflt_run may fail to set g->g.to (which must be a valid index + into lgstring) correctly if the font has an OTF table that is + different from what the m17n library expects. */ for (i = 0; i < gstring.used; i++) { MFLTGlyphFT *g = (MFLTGlyphFT *) (gstring.glyphs) + i; + if (g->g.to >= len) + { + /* Invalid g->g.to. */ + g->g.to = len - 1; + int from = g->g.from; + /* Fix remaining glyphs. */ + for (++i; i < gstring.used; i++) + { + g = (MFLTGlyphFT *) (gstring.glyphs) + i; + g->g.from = from; + g->g.to = len - 1; + } + } + } + for (i = 0; i < gstring.used; i++) + { + MFLTGlyphFT *g = (MFLTGlyphFT *) (gstring.glyphs) + i; g->g.from = LGLYPH_FROM (LGSTRING_GLYPH (lgstring, g->g.from)); g->g.to = LGLYPH_TO (LGSTRING_GLYPH (lgstring, g->g.to)); } commit 3dd87631fca9384fce9f9a72df02ae55b1d3c946 Author: Earl Hyatt Date: Sat Jun 19 08:30:31 2021 -0400 Add commands 'kill-matching-lines' and 'copy-matching-lines' * doc/emacs/search.texi: Document these additions. * lisp/replace.el: Add the commands 'kill-matching-lines' and 'copy-matching-lines'. 'kill-matching-lines' is like 'flush-lines', but adds the lines to the kill ring as a single string, keeping line endings. 'copy-matching-lines' is like 'kill-matching-lines', but only copies those lines instead of killing them. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index e6b066e973..a1760ad66f 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1971,6 +1971,17 @@ it never deletes lines that are only partially contained in the region (a newline that ends a line counts as part of that line). If a match is split across lines, this command keeps all those lines. + +@findex kill-matching-lines +@item M-x kill-matching-lines +Like @code{flush-lines}, but also add the matching lines to the kill +ring. The command adds the matching lines to the kill ring as a +single string, including the newlines that separated the lines. + +@findex copy-matching-lines +@item M-x copy-matching-lines +Like @code{kill-matching-lines}, but the matching lines are not +removed from the buffer. @end table @node Search Customizations diff --git a/etc/NEWS b/etc/NEWS index 922b2ab6eb..953c952d05 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -484,6 +484,11 @@ highlighting on heading lines using standard outline faces. This works well only when there are no conflicts with faces used by the major mode. +** New commands 'copy-matching-lines' and 'kill-matching-lines'. +These commands are similar to the command 'flush-lines', +but add the matching lines to the kill ring as a single string, +including the newlines that separate the lines. + * Changes in Specialized Modes and Packages in Emacs 28.1 diff --git a/lisp/replace.el b/lisp/replace.el index ed81097e14..7e30f1fc55 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1054,6 +1054,130 @@ also print the number." count)) count)) +(defun kill-matching-lines (regexp &optional rstart rend interactive) + "Kill lines containing matches for REGEXP. + +When called from Lisp (and usually when called interactively as +well, see below), applies to the part of the buffer after point. +The line point is in is killed if and only if it contains a match +for REGEXP starting after point. + +If REGEXP contains upper case characters (excluding those +preceded by `\\') and `search-upper-case' is non-nil, the +matching is case-sensitive. + +Second and third args RSTART and REND specify the region to +operate on. Lines partially contained in this region are killed +if and only if they contain a match entirely contained in the +region. + +Interactively, in Transient Mark mode when the mark is active, +operate on the contents of the region. Otherwise, operate from +point to the end of (the accessible portion of) the buffer. + +If a match is split across lines, all the lines it lies in are +killed. They are killed _before_ looking for the next match. +Hence, a match starting on the same line at which another match +ended is ignored. + +Return the number of killed matching lines. When called +interactively, also print the number." + (interactive + (progn + (barf-if-buffer-read-only) + (keep-lines-read-args "Kill lines containing match for regexp"))) + (if rstart + (progn + (goto-char (min rstart rend)) + (setq rend (copy-marker (max rstart rend)))) + (if (and interactive (use-region-p)) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) + (let ((count 0) + (case-fold-search + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search))) + (save-excursion + (while (and (< (point) rend) + (re-search-forward regexp rend t)) + (unless (zerop count) + (setq last-command 'kill-region)) + (kill-region (save-excursion (goto-char (match-beginning 0)) + (forward-line 0) + (point)) + (progn (forward-line 1) (point))) + (setq count (1+ count)))) + (set-marker rend nil) + (when interactive (message (ngettext "Killed %d matching line" + "Killed %d matching lines" + count) + count)) + count)) + +(defun copy-matching-lines (regexp &optional rstart rend interactive) + "Copy lines containing matches for REGEXP to the kill ring. + +When called from Lisp (and usually when called interactively as +well, see below), applies to the part of the buffer after point. +The line point is in is copied if and only if it contains a match +for REGEXP starting after point. + +If REGEXP contains upper case characters (excluding those +preceded by `\\') and `search-upper-case' is non-nil, the +matching is case-sensitive. + +Second and third args RSTART and REND specify the region to +operate on. Lines partially contained in this region are copied +if and only if they contain a match entirely contained in the +region. + +Interactively, in Transient Mark mode when the mark is active, +operate on the contents of the region. Otherwise, operate from +point to the end of (the accessible portion of) the buffer. + +If a match is split across lines, all the lines it lies in are +copied. + +Return the number of copied matching lines. When called +interactively, also print the number." + (interactive + (keep-lines-read-args "Copy lines containing match for regexp")) + (if rstart + (progn + (goto-char (min rstart rend)) + (setq rend (copy-marker (max rstart rend)))) + (if (and interactive (use-region-p)) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) + (let ((count 0) + (case-fold-search + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search))) + (save-excursion + (while (and (< (point) rend) + (re-search-forward regexp rend t)) + (unless (zerop count) + (setq last-command 'kill-region)) + (copy-region-as-kill (save-excursion (goto-char (match-beginning 0)) + (forward-line 0) + (point)) + (progn (forward-line 1) (point))) + (setq count (1+ count)))) + (set-marker rend nil) + (when interactive (message (ngettext "Copied %d matching line" + "Copied %d matching lines" + count) + count)) + count)) + (defun how-many (regexp &optional rstart rend interactive) "Print and return number of matches for REGEXP following point. When called from Lisp and INTERACTIVE is omitted or nil, just return commit 0499294a3612d7ba34c5385e11ab0ac1f1cb3416 Author: Lars Ingebrigtsen Date: Tue Jul 20 14:06:40 2021 +0200 Tweak example in Function Indirection node in the lispref manual * doc/lispref/eval.texi (Function Indirection): Make example more robust (bug#49647). Suggested by Scott Marks . diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index 448b8ae17a..7893895eee 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -350,7 +350,8 @@ Here is how you could define @code{indirect-function} in Lisp: @example (defun indirect-function (function) - (if (symbolp function) + (if (and function + (symbolp function)) (indirect-function (symbol-function function)) function)) @end example commit e02576c7eb75f35e5cc4fa5aa213f0838e2bd168 Author: Lars Ingebrigtsen Date: Tue Jul 20 13:48:10 2021 +0200 Put command line file names and mouse dragging onto 'file-name-history' * lisp/dnd.el (dnd-open-local-file): Add file to history. * lisp/files.el (file-name-history--add): New function (bug#12915). * lisp/startup.el (command-line-1): Add file to history. diff --git a/etc/NEWS b/etc/NEWS index 7bf42330b9..922b2ab6eb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -91,6 +91,10 @@ proper pty support that Emacs needs. * Startup Changes in Emacs 28.1 +--- +** File names given on the command line will now be pushed onto +'file-name-history'. + --- ** In GTK builds, Emacs now supports startup notification. This means that Emacs won't steal keyboard focus upon startup @@ -335,6 +339,10 @@ by dragging the tab lines of their topmost windows with the mouse. * Editing Changes in Emacs 28.1 +--- +** Dragging a file to Emacs will now also push the name of the file +onto 'file-name-history'. + +++ ** A prefix arg now causes 'delete-other-frames' to only iconify frames. diff --git a/lisp/dnd.el b/lisp/dnd.el index 7319a27d19..e641b2843a 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -180,6 +180,7 @@ An alternative for systems that do not support unc file names is (if dnd-open-file-other-window (find-file-other-window f) (find-file f)) + (file-name-history--add f) 'private) (error "Can not read %s" uri)))) diff --git a/lisp/files.el b/lisp/files.el index 59077cd266..c265f33550 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1702,6 +1702,10 @@ rather than FUN itself, to `minibuffer-setup-hook'." (list (read-file-name prompt nil default-directory mustmatch) t)) +(defun file-name-history--add (file) + "Add FILE to `file-name-history'." + (add-to-history 'file-name-history (abbreviate-file-name file))) + (defun find-file (filename &optional wildcards) "Edit file FILENAME. Switch to a buffer visiting file FILENAME, diff --git a/lisp/startup.el b/lisp/startup.el index 456c01efd1..f337f7c6bc 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2391,6 +2391,7 @@ nil default-directory" name) (command-line-normalize-file-name name) dir)) (buf (find-file-noselect file))) + (file-name-history--add file) (setq displayable-buffers (cons buf displayable-buffers)) ;; Set the file buffer to the current buffer so ;; that it will be used with "--eval" and commit 06ee8ac36c9590ed028a3633a21a655104f772c8 Author: Lars Ingebrigtsen Date: Tue Jul 20 13:32:39 2021 +0200 Mention `overlays-in' in the `overlays-at' doc string * src/buffer.c (Foverlays_at): Mention `overlays-in' in the doc string (bug#459). diff --git a/src/buffer.c b/src/buffer.c index d3a5ffd149..335523de60 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4222,7 +4222,11 @@ OVERLAY. */) DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 2, 0, doc: /* Return a list of the overlays that contain the character at POS. -If SORTED is non-nil, then sort them by decreasing priority. */) +If SORTED is non-nil, then sort them by decreasing priority. + +Zero-length overlays that start and stop at POS are not included in +the return value. Instead use `overlays-in' if those overlays are of +interest. */) (Lisp_Object pos, Lisp_Object sorted) { ptrdiff_t len, noverlays; diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 2adffc024a..20f85c6c93 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1386,4 +1386,17 @@ with parameters from the *Messages* buffer modification." (when (buffer-live-p base) (kill-buffer base))))))) +(ert-deftest zero-length-overlays-and-not () + (with-temp-buffer + (insert "hello") + (let ((long-overlay (make-overlay 2 4)) + (zero-overlay (make-overlay 3 3))) + ;; Exclude. + (should (= (length (overlays-at 3)) 1)) + (should (eq (car (overlays-at 3)) long-overlay)) + ;; Include. + (should (= (length (overlays-in 3 3)) 2)) + (should (memq long-overlay (overlays-in 3 3))) + (should (memq zero-overlay (overlays-in 3 3)))))) + ;;; buffer-tests.el ends here commit 6ebe8b03d80038d0c79ee0119efcd8272bb6a551 Author: Lars Ingebrigtsen Date: Mon Jul 19 19:03:28 2021 +0200 Make wdired work better in narrowed-to buffers * lisp/wdired.el (wdired--before-change-fn): (wdired--restore-properties): Widen before doing anything so that we get all the changed bits (bug#49124). diff --git a/lisp/wdired.el b/lisp/wdired.el index 22c1cebe13..fd549bac32 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -297,26 +297,28 @@ or \\[wdired-abort-changes] to abort changes"))) (defun wdired--before-change-fn (beg end) (save-match-data (save-excursion - ;; Make sure to process entire lines. - (goto-char end) - (setq end (line-end-position)) - (goto-char beg) - (forward-line 0) - - (while (< (point) end) - (unless (wdired--line-preprocessed-p) + (save-restriction + (widen) + ;; Make sure to process entire lines. + (goto-char end) + (setq end (line-end-position)) + (goto-char beg) + (forward-line 0) + + (while (< (point) end) + (unless (wdired--line-preprocessed-p) + (with-silent-modifications + (put-text-property (point) (1+ (point)) 'front-sticky t) + (wdired--preprocess-files) + (when wdired-allow-to-change-permissions + (wdired--preprocess-perms)) + (when (fboundp 'make-symbolic-link) + (wdired--preprocess-symlinks)))) + (forward-line)) + (when (eobp) (with-silent-modifications - (put-text-property (point) (1+ (point)) 'front-sticky t) - (wdired--preprocess-files) - (when wdired-allow-to-change-permissions - (wdired--preprocess-perms)) - (when (fboundp 'make-symbolic-link) - (wdired--preprocess-symlinks)))) - (forward-line)) - (when (eobp) - (with-silent-modifications - ;; Is this good enough? Assumes no extra white lines from dired. - (put-text-property (1- (point-max)) (point-max) 'read-only t)))))) + ;; Is this good enough? Assumes no extra white lines from dired. + (put-text-property (1- (point-max)) (point-max) 'read-only t))))))) (defun wdired-isearch-filter-read-only (beg end) "Skip matches that have a read-only property." @@ -700,47 +702,49 @@ Optional arguments are ignored." (defun wdired--restore-properties (beg end _len) (save-match-data (save-excursion - (let ((lep (line-end-position)) - (used-F (dired-check-switches - dired-actual-switches - "F" "classify"))) - ;; Deleting the space between the link name and the arrow (a - ;; noop) also deletes the end-name property, so restore it. - (when (and (save-excursion - (re-search-backward dired-permission-flags-regexp nil t) - (looking-at "l")) - (get-text-property (1- (point)) 'dired-filename) - (not (get-text-property (point) 'dired-filename)) - (not (get-text-property (point) 'end-name))) + (save-restriction + (widen) + (let ((lep (line-end-position)) + (used-F (dired-check-switches + dired-actual-switches + "F" "classify"))) + ;; Deleting the space between the link name and the arrow (a + ;; noop) also deletes the end-name property, so restore it. + (when (and (save-excursion + (re-search-backward dired-permission-flags-regexp nil t) + (looking-at "l")) + (get-text-property (1- (point)) 'dired-filename) + (not (get-text-property (point) 'dired-filename)) + (not (get-text-property (point) 'end-name))) (put-text-property (point) (1+ (point)) 'end-name t)) - (beginning-of-line) - (when (re-search-forward - directory-listing-before-filename-regexp lep t) - (setq beg (point) - end (if (or - ;; If the file is a symlink, put the - ;; dired-filename property only on the link - ;; name. (Using (file-symlink-p - ;; (dired-get-filename)) fails in - ;; wdired-mode, bug#32673.) - (and (re-search-backward - dired-permission-flags-regexp nil t) - (looking-at "l") - ;; macOS and Ultrix adds "@" to the end - ;; of symlinks when using -F. - (if (and used-F - dired-ls-F-marks-symlinks) - (re-search-forward "@? -> " lep t) - (search-forward " -> " lep t))) - ;; When dired-listing-switches includes "F" - ;; or "classify", don't treat appended - ;; indicator characters as part of the file - ;; name (bug#34915). - (and used-F - (re-search-forward "[*/@|=>]$" lep t))) - (goto-char (match-beginning 0)) - lep)) - (put-text-property beg end 'dired-filename t)))))) + (beginning-of-line) + (when (re-search-forward + directory-listing-before-filename-regexp lep t) + (setq beg (point) + end (if (or + ;; If the file is a symlink, put the + ;; dired-filename property only on the link + ;; name. (Using (file-symlink-p + ;; (dired-get-filename)) fails in + ;; wdired-mode, bug#32673.) + (and (re-search-backward + dired-permission-flags-regexp nil t) + (looking-at "l") + ;; macOS and Ultrix adds "@" to the end + ;; of symlinks when using -F. + (if (and used-F + dired-ls-F-marks-symlinks) + (re-search-forward "@? -> " lep t) + (search-forward " -> " lep t))) + ;; When dired-listing-switches includes "F" + ;; or "classify", don't treat appended + ;; indicator characters as part of the file + ;; name (bug#34915). + (and used-F + (re-search-forward "[*/@|=>]$" lep t))) + (goto-char (match-beginning 0)) + lep)) + (put-text-property beg end 'dired-filename t))))))) (defun wdired-next-line (arg) "Move down lines then position at filename or the current column. commit f7f2024b86bdcf028ce942e59d1cfdba89747d0b Author: Ivan Sokolov Date: Mon Jul 19 18:54:18 2021 +0200 Add function for filtering ANSI sequences when compiling * lisp/ansi-color.el (ansi-color-for-compilation-mode): New user option (bug#49609). (ansi-color-compilation-filter): New function. diff --git a/etc/NEWS b/etc/NEWS index 0c90683c76..7bf42330b9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1601,6 +1601,14 @@ Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options. ** Compilation mode +--- +*** New function 'ansi-color-compilation-filter'. +This function is meant to be used in 'compilation-filter-hook'. + +--- +*** New user option 'ansi-color-for-compilation-mode'. +This controls what 'ansi-color-compilation-filter' does. + *** Regexp matching of messages is now case-sensitive by default. The variable 'compilation-error-case-fold-search' can be set for case-insensitive matching of messages when the old behavior is diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 44dc0351d4..79dc821ea1 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -75,6 +75,7 @@ ;;; Code: (defvar comint-last-output-start) +(defvar compilation-filter-start) ;; Customization @@ -181,6 +182,24 @@ in shell buffers. You set this variable by calling one of: :group 'ansi-colors :version "23.2") +(defcustom ansi-color-for-compilation-mode t + "Determines what to do with compilation output. +If nil, do nothing. + +If the symbol `filter', then filter all ANSI graphical control +sequences. + +If anything else (such as t), then translate ANSI graphical +control sequences into text properties. + +In order for this to have any effect, `ansi-color-compilation-filter' +must be in `compilation-filter-hook'." + :type '(choice (const :tag "Do nothing" nil) + (const :tag "Filter" filter) + (other :tag "Translate" t)) + :group 'ansi-colors + :version "28.1") + (defvar ansi-color-apply-face-function #'ansi-color-apply-overlay-face "Function for applying an Ansi Color face to text in a buffer. This function should accept three arguments: BEG, END, and FACE, @@ -228,6 +247,19 @@ This is a good function to put in `comint-output-filter-functions'." (t (ansi-color-apply-on-region start-marker end-marker))))) +;;;###autoload +(defun ansi-color-compilation-filter () + "Maybe translate SGR control sequences into text properties. +This function depends on the `ansi-color-for-compilation-mode' +variable, and is meant to be used in `compilation-filter-hook'." + (let ((inhibit-read-only t)) + (pcase ansi-color-for-compilation-mode + ('nil nil) + ('filter + (ansi-color-filter-region compilation-filter-start (point))) + (_ + (ansi-color-apply-on-region compilation-filter-start (point)))))) + (define-obsolete-function-alias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region "24.1") commit 0c48469ac11ea0120d050b79072a6dcb1798d2e0 Author: Eli Zaretskii Date: Mon Jul 19 19:46:43 2021 +0300 Fix typos in a recent change * src/buffer.c (Fmake_indirect_buffer): Fix a typo in a recent change. * doc/lispref/buffers.texi (Indirect Buffers): Fix punctuation. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 02bbc67c5d..55e9d00d8b 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -1200,7 +1200,7 @@ the base for the new buffer. If, in addition, @var{clone} is non-@code{nil}, the initial state is copied from the actual base buffer, not from @var{base-buffer}. -@xref{Creating Buffers} for the meaning of @var{inhibit-buffer-hooks}. +@xref{Creating Buffers}, for the meaning of @var{inhibit-buffer-hooks}. @end deffn @deffn Command clone-indirect-buffer newname display-flag &optional norecord diff --git a/src/buffer.c b/src/buffer.c index 18c4734906..d3a5ffd149 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -841,7 +841,7 @@ does not run the hooks `kill-buffer-hook', b->pt_byte = b->base_buffer->pt_byte; b->begv_byte = b->base_buffer->begv_byte; b->zv_byte = b->base_buffer->zv_byte; - b->inhibit_buffer_hooks = inhibit_buffer_hooks; + b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks); b->newline_cache = 0; b->width_run_cache = 0; commit 072512414efa80a680d9380ad8b7c9d1e2a1c1a6 Author: Lars Ingebrigtsen Date: Mon Jul 19 18:35:09 2021 +0200 Make the `s' command in *Help* work for Lisp variables defined in C * lisp/help-fns.el (describe-variable): Store the type. * lisp/help-mode.el (help-view-source): Use the type. This fixes the problem when looking for a variable defined in a C file. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 81d7f23fe3..7641774615 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1078,6 +1078,7 @@ it is displayed along with the global value." (with-current-buffer standard-output (setq help-mode--current-data (list :symbol variable + :type 'variable :file file-name)) (save-excursion (re-search-backward (substitute-command-keys @@ -1089,7 +1090,8 @@ it is displayed along with the global value." "It is void as a variable." "Its ")) (with-current-buffer standard-output - (setq help-mode--current-data (list :symbol variable))) + (setq help-mode--current-data (list :symbol variable + :type 'variable))) (if valvoid " is void as a variable." (substitute-command-keys "'s "))))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 4e73551cfb..3976a9ac4e 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -738,8 +738,10 @@ See `help-make-xrefs'." (interactive nil help-mode) (unless (plist-get help-mode--current-data :file) (error "Source file for the current help item is not defined")) - (help-function-def--button-function (plist-get help-mode--current-data :symbol) - (plist-get help-mode--current-data :file))) + (help-function-def--button-function + (plist-get help-mode--current-data :symbol) + (plist-get help-mode--current-data :file) + (plist-get help-mode--current-data :type))) (defun help-goto-info () "View the *info* node of the current help item." commit f5640a3bdf33ca6fef749f5e53a26ed749a6d595 Merge: b2925ad125 514398c665 Author: Eli Zaretskii Date: Mon Jul 19 19:24:41 2021 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit b2925ad125fe4ab54c2bb085c0aae907db717ce5 Author: Eli Zaretskii Date: Mon Jul 19 19:24:01 2021 +0300 ; Fix a typo in a recent change * src/callint.c (syms_of_callint) : Fix a typo in the doc string. diff --git a/src/callint.c b/src/callint.c index a196210250..6f8a7f13f6 100644 --- a/src/callint.c +++ b/src/callint.c @@ -894,7 +894,7 @@ behave as if the mark were still active. */); DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook, doc: /* Hook run when the user mouse-clicks in a window. It can be run both before and after switching windows, or even when -when not actually switching windows. +not actually switching windows. Its purpose is to give temporary modes such as Isearch mode a way to turn themselves off when a mouse command switches windows. */); commit 514398c66576162c6bf5d8bd1d0ae3d2c6b83b49 Author: Lars Ingebrigtsen Date: Mon Jul 19 18:23:07 2021 +0200 Add inhibit-buffer-hooks to `make-indirect-buffer' * doc/lispref/buffers.texi (Indirect Buffers): Document it (bug#49160). * src/buffer.c (Fmake_indirect_buffer): Allow controlling whether to inhibit buffer hooks. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 0d31b0bc4c..02bbc67c5d 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -1183,7 +1183,7 @@ buffer. the base buffer effectively kills the indirect buffer in that it cannot ever again be the current buffer. -@deffn Command make-indirect-buffer base-buffer name &optional clone +@deffn Command make-indirect-buffer base-buffer name &optional clone inhibit-buffer-hooks This creates and returns an indirect buffer named @var{name} whose base buffer is @var{base-buffer}. The argument @var{base-buffer} may be a live buffer or the name (a string) of an existing buffer. If @@ -1199,6 +1199,8 @@ If @var{base-buffer} is an indirect buffer, its base buffer is used as the base for the new buffer. If, in addition, @var{clone} is non-@code{nil}, the initial state is copied from the actual base buffer, not from @var{base-buffer}. + +@xref{Creating Buffers} for the meaning of @var{inhibit-buffer-hooks}. @end deffn @deffn Command clone-indirect-buffer newname display-flag &optional norecord diff --git a/src/buffer.c b/src/buffer.c index a574de1672..18c4734906 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -781,15 +781,22 @@ fetch_buffer_markers (struct buffer *b) DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, - 2, 3, + 2, 4, "bMake indirect buffer (to buffer): \nBName of indirect buffer: ", doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME. BASE-BUFFER should be a live buffer, or the name of an existing buffer. + NAME should be a string which is not the name of an existing buffer. Optional argument CLONE non-nil means preserve BASE-BUFFER's state, such as major and minor modes, in the indirect buffer. -CLONE nil means the indirect buffer's state is reset to default values. */) - (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone) + +CLONE nil means the indirect buffer's state is reset to default values. + +If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the new buffer +does not run the hooks `kill-buffer-hook', +`kill-buffer-query-functions', and `buffer-list-update-hook'. */) + (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone, + Lisp_Object inhibit_buffer_hooks) { Lisp_Object buf, tem; struct buffer *b; @@ -834,7 +841,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) b->pt_byte = b->base_buffer->pt_byte; b->begv_byte = b->base_buffer->begv_byte; b->zv_byte = b->base_buffer->zv_byte; - b->inhibit_buffer_hooks = b->base_buffer->inhibit_buffer_hooks; + b->inhibit_buffer_hooks = inhibit_buffer_hooks; b->newline_cache = 0; b->width_run_cache = 0; diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 0161927419..2adffc024a 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1369,7 +1369,8 @@ with parameters from the *Messages* buffer modification." (dotimes (_i 11) (let* (flag* (flag (lambda () (prog1 t (setq flag* t)))) - (indirect (make-indirect-buffer base "foo[indirect]"))) + (indirect (make-indirect-buffer base "foo[indirect]" nil + inhibit))) (unwind-protect (progn (with-current-buffer indirect commit 95e31a1a328a7548efa76befa74d430925ca7f6d Author: dickmao Date: Mon Jul 19 18:12:17 2021 +0200 Make make-indirect-buffer inherit inhibit-buffer-hook from base buffer * src/buffer.c (Fmake_indirect_buffer): Match base buffer's inhibit-buffer-hooks. * test/src/buffer-tests.el (buffer-tests-inhibit-buffer-hooks-indirect): Add a test (bug#49160). diff --git a/src/buffer.c b/src/buffer.c index 02ca23eb2d..a574de1672 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -834,6 +834,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) b->pt_byte = b->base_buffer->pt_byte; b->begv_byte = b->base_buffer->begv_byte; b->zv_byte = b->base_buffer->zv_byte; + b->inhibit_buffer_hooks = b->base_buffer->inhibit_buffer_hooks; b->newline_cache = 0; b->width_run_cache = 0; diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 123f2e8eab..0161927419 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1361,4 +1361,28 @@ with parameters from the *Messages* buffer modification." (should run-kbqf)) (remove-hook 'buffer-list-update-hook bluh)))) +(ert-deftest buffer-tests-inhibit-buffer-hooks-indirect () + "Indirect buffers do not call `get-buffer-create'." + (dolist (inhibit '(nil t)) + (let ((base (get-buffer-create "foo" inhibit))) + (unwind-protect + (dotimes (_i 11) + (let* (flag* + (flag (lambda () (prog1 t (setq flag* t)))) + (indirect (make-indirect-buffer base "foo[indirect]"))) + (unwind-protect + (progn + (with-current-buffer indirect + (add-hook 'kill-buffer-query-functions flag nil t)) + (kill-buffer indirect) + (if inhibit + (should-not flag*) + (should flag*))) + (let (kill-buffer-query-functions) + (when (buffer-live-p indirect) + (kill-buffer indirect)))))) + (let (kill-buffer-query-functions) + (when (buffer-live-p base) + (kill-buffer base))))))) + ;;; buffer-tests.el ends here commit dd70012dca136d1218987b602ce22330e406cb26 Author: Eli Zaretskii Date: Mon Jul 19 19:21:49 2021 +0300 Document recent changes in 'comint-delete-output' (bug#1496) * doc/emacs/misc.texi (Shell Mode): Document the new optional behavior of 'C-c C-o'. * etc/NEWS: Call out the new behavior of 'C-c C-o'. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 12cd492b4b..aba98cf21e 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1021,7 +1021,10 @@ pending in the shell buffer and not yet sent. @findex comint-delete-output Delete the last batch of output from a shell command (@code{comint-delete-output}). This is useful if a shell command spews -out lots of output that just gets in the way. +out lots of output that just gets in the way. With a prefix argument, +this command saves the deleted text in the @code{kill-ring} +(@pxref{Kill Ring}), so that you could later yank it (@pxref{Yanking}) +elsewhere. @item C-c C-s @kindex C-c C-s @r{(Shell mode)} diff --git a/etc/NEWS b/etc/NEWS index 42869f44dc..0c90683c76 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1426,6 +1426,10 @@ If non-nil, 'shell-mode' handles implicit "cd" commands, changing the directory if the command is a directory. Useful for shells like "zsh" that has this feature. ++++ +*** 'comint-delete-output' can now save deleted text in the kill-ring. +Interactively, 'C-u C-c C-o' triggers this new optional behavior. + ** Eshell --- commit 513539524e947a231ee0b2fc307d4afe3969c1ef Author: Gabriel do Nascimento Ribeiro Date: Mon Jul 19 18:04:25 2021 +0200 Use 'remember-buffer' in remember.el doc strings. * lisp/textmodes/remember.el (remember-initial-contents) (remember-before-remember-hook, remember-destroy): Refer to `remember-buffer'. * lisp/textmodes/remember.el (remember-buffer): Make into defcustom (bug#49373). diff --git a/etc/NEWS b/etc/NEWS index e241b512b6..42869f44dc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -581,6 +581,11 @@ indentation is done using SMIE or with the old ad-hoc code. ** Icomplete +--- +*** New user option 'icomplete-matches-format'. +This allows controlling the current/total number of matches for the +prompt prefix. + +++ *** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode'. This mode is intended to be used with Icomplete ('M-x icomplete-mode') diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 576fced015..adea1505fd 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -97,6 +97,12 @@ Otherwise this should be a list of the completion tables (e.g., :type '(choice (const :tag "All" t) (repeat function))) +(defcustom icomplete-matches-format "%s/%s " + "Format of the current/total number of matches for the prompt prefix." + :version "28.1" + :type '(choice (const :tag "No prefix" nil) + (string :tag "Prefix format string"))) + (defface icomplete-first-match '((t :weight bold)) "Face used by Icomplete for highlighting first match." :version "24.4") @@ -696,12 +702,12 @@ See `icomplete-mode' and `minibuffer-setup-hook'." (overlay-put icomplete-overlay 'before-string (and icomplete-scroll - (let ((past (length icomplete--scrolled-past))) - (format - "%s/%s " - (1+ past) - (+ past - (safe-length completion-all-sorted-completions)))))) + icomplete-matches-format + (let* ((past (length icomplete--scrolled-past)) + (current (1+ past)) + (total (+ past (safe-length + completion-all-sorted-completions)))) + (format icomplete-matches-format current total)))) (overlay-put icomplete-overlay 'after-string text)))))))) (defun icomplete--affixate (md prospects) commit 069f790ca3040f14b9f5d1358d66a480f5f5fa90 Author: Gabriel do Nascimento Ribeiro Date: Mon Jul 19 17:47:30 2021 +0200 Use 'remember-buffer' in remember.el doc strings. * lisp/textmodes/remember.el (remember-initial-contents) (remember-before-remember-hook, remember-destroy): Refer to `remember-buffer'. * lisp/textmodes/remember.el (remember-buffer): Make into defcustom (bug#49373). diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 4acdc9f4d8..fbb66fe40e 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -223,8 +223,10 @@ recorded somewhere by that function." ;;; Internal Variables: -(defvar remember-buffer "*Remember*" - "The name of the remember data entry buffer.") +(defcustom remember-buffer "*Remember*" + "The name of the remember data entry buffer." + :version "28.1" + :type 'string) (defcustom remember-save-after-remembering t "Non-nil means automatically save after remembering." @@ -240,10 +242,10 @@ recorded somewhere by that function." (defvar remember-annotation nil "Current annotation.") (defvar remember-initial-contents nil - "Initial contents to place into *Remember* buffer.") + "Initial contents to place into `remember-buffer'.") (defcustom remember-before-remember-hook nil - "Functions run before switching to the *Remember* buffer." + "Functions run before switching to the `remember-buffer'." :type 'hook) (defcustom remember-run-all-annotation-functions-flag nil @@ -253,8 +255,8 @@ recorded somewhere by that function." ;;;###autoload (defun remember (&optional initial) "Remember an arbitrary piece of data. -INITIAL is the text to initially place in the *Remember* buffer, -or nil to bring up a blank *Remember* buffer. +INITIAL is the text to initially place in the `remember-buffer', +or nil to bring up a blank `remember-buffer'. With a prefix or a visible region, use the region as INITIAL." (interactive @@ -422,7 +424,7 @@ return the text to be remembered." (defun remember-region (&optional beg end) "Remember the data from BEG to END. -It is called from within the *Remember* buffer to save the text +It is called from within the `remember-buffer' to save the text that was entered. If BEG and END are nil, the entire buffer will be remembered. @@ -478,7 +480,7 @@ Most useful for remembering things from other applications." (remember-region (point-min) (point-max))) (defun remember-destroy () - "Destroy the current *Remember* buffer." + "Destroy the current `remember-buffer'." (interactive) (when (equal remember-buffer (buffer-name)) (kill-buffer (current-buffer)) commit 039d00326ebdd7e79b0758c65c7ce98a8fbd8dd1 Author: Madhu Date: Mon Jul 19 17:42:18 2021 +0200 Propagate asynchronousness correctly when using proxies in url.el * lisp/url/url.el (url-retrieve-internal): Propagate asynchronousness correctly when using a proxy (bug#49570). Copyright-paperwork-exempt: yes diff --git a/lisp/url/url.el b/lisp/url/url.el index 8daf9f0a8e..a6565e2cdb 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -208,9 +208,10 @@ URL-encoded before it's used." (url-find-proxy-for-url url (url-host url)))) (buffer nil) (asynch (url-scheme-get-property (url-type url) 'asynchronous-p))) - (if url-using-proxy - (setq asynch t - loader #'url-proxy)) + (when url-using-proxy + (setf asynch t + loader #'url-proxy + (url-asynchronous url) t)) (if asynch (let ((url-current-object url)) (setq buffer (funcall loader url callback cbargs))) commit 8f51194aa5f2e3300d60bca9c7b6630ee11d9a70 Author: Lars Ingebrigtsen Date: Mon Jul 19 17:31:17 2021 +0200 Fix infloop in woman-file-name * lisp/woman.el (woman-file-name): Fix infloop for non-existent manual page (bug#414). diff --git a/lisp/woman.el b/lisp/woman.el index d9aa573d27..0bc992d8f7 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1274,9 +1274,11 @@ cache to be re-read." ;; Complete topic more carefully, i.e. use the completion ;; rather than the string entered by the user: ((setq files (all-completions topic woman-topic-all-completions)) - (while (/= (length topic) (length (car files))) + (while (and files + (/= (length topic) (length (car files)))) (setq files (cdr files))) - (setq files (woman-file-name-all-completions (car files))))) + (when files + (setq files (woman-file-name-all-completions (car files)))))) (cond ((null files) nil) ; no file found for topic. ((null (cdr files)) (car (car files))) ; only 1 file for topic. commit 4ffa928b93cbb53f16b475ccf3742144392d98d8 Author: Lars Ingebrigtsen Date: Mon Jul 19 17:13:11 2021 +0200 Allow comint-delete-output to save the output on the kill ring * lisp/comint.el (comint-delete-output): Allow saving the output to the kill ring (bug#1496). diff --git a/lisp/comint.el b/lisp/comint.el index 9e406614b9..7801261621 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2471,10 +2471,13 @@ This function could be in the list `comint-output-filter-functions'." ;; Random input hackage -(defun comint-delete-output () +(defun comint-delete-output (&optional kill) "Delete all output from interpreter since last input. -Does not delete the prompt." - (interactive) +If KILL (interactively, the prefix), save the killed text in the +kill ring. + +This command does not delete the prompt." + (interactive "P") (let ((proc (get-buffer-process (current-buffer))) (replacement nil) (inhibit-read-only t)) @@ -2482,6 +2485,8 @@ Does not delete the prompt." (let ((pmark (progn (goto-char (process-mark proc)) (forward-line 0) (point-marker)))) + (when kill + (copy-region-as-kill comint-last-input-end pmark)) (delete-region comint-last-input-end pmark) (goto-char (process-mark proc)) (setq replacement (concat "*** output flushed ***\n" commit 3094c12c45a60203052fc1fac1b793b982cdd787 Author: Lars Ingebrigtsen Date: Mon Jul 19 16:41:54 2021 +0200 Fix documentation of mouse-leave-buffer-hook * doc/lispref/hooks.texi (Standard Hooks): Ditto. * src/callint.c (syms_of_callint): Document the actual usage of `mouse-leave-buffer-hook' (bug#2932). diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi index b1c7e61371..394928454b 100644 --- a/doc/lispref/hooks.texi +++ b/doc/lispref/hooks.texi @@ -184,7 +184,7 @@ The command loop runs this soon after @code{post-command-hook} (q.v.). @item mouse-leave-buffer-hook @vindex mouse-leave-buffer-hook -Hook run when about to switch windows with a mouse command. +Hook run when the user mouse-clicks in a window. @item mouse-position-function @xref{Mouse Position}. diff --git a/src/callint.c b/src/callint.c index 1862463784..a196210250 100644 --- a/src/callint.c +++ b/src/callint.c @@ -892,7 +892,10 @@ behave as if the mark were still active. */); Vmark_even_if_inactive = Qt; DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook, - doc: /* Hook to run when about to switch windows with a mouse command. + doc: /* Hook run when the user mouse-clicks in a window. +It can be run both before and after switching windows, or even when +when not actually switching windows. + Its purpose is to give temporary modes such as Isearch mode a way to turn themselves off when a mouse command switches windows. */); Vmouse_leave_buffer_hook = Qnil; commit 6336c18e5c9270d745e42b516c35ef0816f67f9b Author: Lars Ingebrigtsen Date: Mon Jul 19 16:13:57 2021 +0200 Use make-separator-line in shortdoc * lisp/simple.el (separator-line): Tweak definition to not be so overwhelming. * lisp/emacs-lisp/shortdoc.el (shortdoc-separator): Removed. (shortdoc-display-group): Use make-separator-line. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 4beba1dbed..22439f4c36 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -32,14 +32,6 @@ "Short documentation." :group 'lisp) -(defface shortdoc-separator - '((((class color) (background dark)) - :height 0.1 :background "#505050" :extend t) - (((class color) (background light)) - :height 0.1 :background "#a0a0a0" :extend t) - (t :height 0.1 :inverse-video t :extend t)) - "Face used to separate sections.") - (defface shortdoc-heading '((t :inherit variable-pitch :height 1.3 :weight bold)) "Face used for a heading." @@ -1174,7 +1166,7 @@ If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)." ;; There may be functions not yet defined in the data. ((fboundp (car data)) (when prev - (insert (propertize "\n" 'face 'shortdoc-separator))) + (insert (make-separator-line))) (setq prev t) (shortdoc--display-function data)))) (cdr (assq group shortdoc--groups)))) diff --git a/lisp/simple.el b/lisp/simple.el index ea3ccb388e..5741c24eb7 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -696,7 +696,10 @@ When called from Lisp code, ARG may be a prefix string to copy." (goto-char pos))) (defface separator-line - '((((type graphic)) :height 0.1 :inverse-video t) + '((((type graphic) (background dark)) + :height 0.1 :background "#505050") + (((type graphic) (background light)) + :height 0.1 :background "#a0a0a0") (t :foreground "ForestGreen")) "Face for separator lines." :version "28.1" commit 620e35f09fd5c2cc08792bb88de57047e29620ad Author: Lars Ingebrigtsen Date: Mon Jul 19 15:48:20 2021 +0200 Add a new function for separator lines * lisp/help-fns.el (describe-symbol): Use it. * lisp/help.el (describe-key): Use it. * lisp/simple.el (separator-line): New face. (make-separator-line): New function (bug#49630). diff --git a/etc/NEWS b/etc/NEWS index 29568e7fd5..e241b512b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2222,6 +2222,13 @@ This command, called interactively, toggles the local value of ** Miscellaneous +--- +*** New utility function 'make-separator-line'. + +--- +*** New face 'separator-line'. +This is used by 'make-separator-line'. + +++ *** New user option 'ignored-local-variable-values'. This is the opposite of 'safe-local-variable-values' -- it's an alist diff --git a/lisp/help-fns.el b/lisp/help-fns.el index cb248b1d00..81d7f23fe3 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1573,11 +1573,7 @@ current buffer and the selected frame, respectively." (insert doc) (delete-region (point) (progn (skip-chars-backward " \t\n") (point))) - (insert "\n\n" - (eval-when-compile - (propertize "\n" 'face - '(:height 0.1 :inverse-video t :extend t))) - "\n") + (insert "\n\n" (make-separator-line) "\n") (when name (insert (symbol-name symbol) " is also a " name "." "\n\n")))) diff --git a/lisp/help.el b/lisp/help.el index 1bb1b30772..ba27fc5810 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -943,12 +943,7 @@ current buffer." (when defn (when (> (length info-list) 1) (with-current-buffer standard-output - (insert "\n\n" - ;; FIXME: Can't use eval-when-compile because purified - ;; strings lose their text properties :-( - (propertize "\n" 'face - '(:height 0.1 :inverse-video t :extend t)) - "\n"))) + (insert "\n\n" (make-separator-line) "\n"))) (princ brief-desc) (when locus diff --git a/lisp/simple.el b/lisp/simple.el index 6de2190221..ea3ccb388e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -695,6 +695,27 @@ When called from Lisp code, ARG may be a prefix string to copy." (indent-to col 0) (goto-char pos))) +(defface separator-line + '((((type graphic)) :height 0.1 :inverse-video t) + (t :foreground "ForestGreen")) + "Face for separator lines." + :version "28.1" + :group 'text) + +(defun make-separator-line (&optional length) + "Make a string appropriate for usage as a visual separator line. +This uses the `separator-line' face. + +If LENGTH is nil, use the window width." + (if (display-graphic-p) + (if length + (concat (propertize (make-string length ?\s) 'face 'separator-line) + "\n") + (propertize "\n" 'face '(:inherit separator-line :extend t))) + (concat (propertize (make-string (or length (1- (window-width))) ?-) + 'face 'separator-line) + "\n"))) + (defun delete-indentation (&optional arg beg end) "Join this line to previous and fix up whitespace at join. If there is a fill prefix, delete it from the beginning of this commit 13b247c3c48a3e8b64ece8d4014c484473c8e362 Author: Basil L. Contovounesios Date: Sun Jul 18 23:06:45 2021 +0100 ; Fix omission in last change to custom.texi. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 0a417f15d7..ce6290c117 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1273,7 +1273,7 @@ safe. You can also tell Emacs to permanently ignore all the variable/value pairs in the file, by typing @kbd{i} at the confirmation prompt -- -these pairs will thereafter ignored in this file and in all other +these pairs will thereafter be ignored in this file and in all other files. @vindex safe-local-variable-values commit b0c73439932eefb8302ec10c61d95ffcf2ef39be Author: Eli Zaretskii Date: Sun Jul 18 21:57:03 2021 +0300 ; * doc/lispref/variables.texi (File Local Variables): Fix last change. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index f2307c8aa7..9356fb9f69 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1997,15 +1997,16 @@ file. @defopt ignored-local-variable-values If there are some values of particular local variables that you always -want to ignore completely, you can this variable. Its value has the -same form as @code{safe-local-variable-values}; a file-local variable -setting to the value that appears in the list will always be ignored -when processing the local variables specified by the file. As with -that variable, when Emacs queries the user about whether to obey a -file-local variable, you can choose to ignore their particular values -permanently, and that will alter this variable and save it to the -user's custom file. Variable-value pairs that appear in this variable -take precedence over the same pairs in @code{safe-local-variable-values}. +want to ignore completely, you can use this variable. Its value has +the same form as @code{safe-local-variable-values}; a file-local +variable setting to the value that appears in the list will always be +ignored when processing the local variables specified by the file. As +with that variable, when Emacs queries the user about whether to obey +file-local variables, the user can choose to ignore their particular +values permanently, and that will alter this variable and save it to +the user's custom file. Variable-value pairs that appear in this +variable take precedence over the same pairs in +@code{safe-local-variable-values}. @end defopt @defun safe-local-variable-p sym val commit bbce22337c5334544da5d0cee0abad954e42a08c Author: Eli Zaretskii Date: Sun Jul 18 21:53:22 2021 +0300 Fix documentation of a recent changeset (bug#5003) * lisp/files.el (safe-local-variable-values) (ignored-local-variable-values): Doc fix. (ignored-local-variable-values): Add :version tag. * doc/emacs/custom.texi (Safe File Variables): Mention 'ignored-local-variable-values'. * doc/lispref/variables.texi (File Local Variables): Fix wording. * etc/NEWS: Improve wording of the 'ignored-local-variable-values' entry. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index bd505d27ec..0a417f15d7 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -623,7 +623,7 @@ button. the theme file and asks if you really want to load it. Because loading a Custom theme can execute arbitrary Lisp code, you should only say yes if you know that the theme is safe; in that case, Emacs -offers to remember in the future that the theme is safe (this is done +offers to remember in the future that the theme is safe(this is done by saving the theme file's SHA-256 hash to the variable @code{custom-safe-themes}; if you want to treat all themes as safe, change its value to @code{t}). Themes that come with Emacs (in the @@ -1271,7 +1271,13 @@ confirmation prompt. When Emacs encounters these variable/value pairs subsequently, in the same file or others, it will assume they are safe. + You can also tell Emacs to permanently ignore all the variable/value +pairs in the file, by typing @kbd{i} at the confirmation prompt -- +these pairs will thereafter ignored in this file and in all other +files. + @vindex safe-local-variable-values +@vindex ignored-local-variable-values @cindex risky variable Some variables, such as @code{load-path}, are considered particularly @dfn{risky}: there is seldom any reason to specify them @@ -1283,6 +1289,8 @@ can enter @kbd{!} at the prompt. It applies all the variables, but only marks the non-risky ones as safe for the future. If you really want to record safe values for risky variables, do it directly by customizing @samp{safe-local-variable-values} (@pxref{Easy Customization}). +Similarly, if you want to record values of risky variables that should +be permanently ignored, customize @code{ignored-local-variable-values}. @vindex enable-local-variables The variable @code{enable-local-variables} allows you to change the diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 541b53fd35..f2307c8aa7 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1996,13 +1996,16 @@ file. @end defopt @defopt ignored-local-variable-values -If there are some local variables that you always want to always -ignore, this variable can be used. It uses the same syntax as -@code{safe-local-variable-values}, but the variable/value pairs here -will always be ignored when handling local variables. As with that -variable, when Emacs queries the user about whether to obey a -file-local variable, the user can choose to ignore them permanently, -and that will alter this variable and save it to the user's custom file. +If there are some values of particular local variables that you always +want to ignore completely, you can this variable. Its value has the +same form as @code{safe-local-variable-values}; a file-local variable +setting to the value that appears in the list will always be ignored +when processing the local variables specified by the file. As with +that variable, when Emacs queries the user about whether to obey a +file-local variable, you can choose to ignore their particular values +permanently, and that will alter this variable and save it to the +user's custom file. Variable-value pairs that appear in this variable +take precedence over the same pairs in @code{safe-local-variable-values}. @end defopt @defun safe-local-variable-p sym val diff --git a/etc/NEWS b/etc/NEWS index 611df3ae39..29568e7fd5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2225,8 +2225,8 @@ This command, called interactively, toggles the local value of +++ *** New user option 'ignored-local-variable-values'. This is the opposite of 'safe-local-variable-values' -- it's an alist -of local variables (and accompanying values) that are to be ignored -when reading a local variable section from a file. +of variable-value pairs that are to be ignored when reading a +local-variables section of a file. --- *** 'indent-tabs-mode' is now a global minor mode instead of just a variable. diff --git a/lisp/files.el b/lisp/files.el index ce4521b8e6..59077cd266 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3435,7 +3435,7 @@ Major modes can use this to examine user-specified local variables in order to initialize other data structure based on them.") (defcustom safe-local-variable-values nil - "List variable-value pairs that are considered safe. + "List of variable-value pairs that are considered safe. Each element is a cons cell (VAR . VAL), where VAR is a variable symbol and VAL is a value that is considered safe. @@ -3445,14 +3445,16 @@ Also see `ignored-local-variable-values'." :type 'alist) (defcustom ignored-local-variable-values nil - "List variable-value pairs that will be ignored. + "List of variable-value pairs that should always be ignored. Each element is a cons cell (VAR . VAL), where VAR is a variable -symbol and VAL is a value that will be ignored. +symbol and VAL is its value; if VAR is set to VAL by a file-local +variables section, that setting should be ignored. Also see `safe-local-variable-values'." :risky t :group 'find-file - :type 'alist) + :type 'alist + :version "28.1") (defcustom safe-local-eval-forms ;; This should be here at least as long as Emacs supports write-file-hooks. commit 88cc9d22df3cbeac92fb280799fae48d8f839a5a Author: Mattias Engdegård Date: Sun Jul 18 20:27:03 2021 +0200 Count compile errors when FILE is a function * lisp/progmodes/compile.el (compilation-parse-errors): Don't omit messages from the error count when FILE is a function rather than a regexp match number. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 7a02c3a896..e4363e11b8 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1540,7 +1540,7 @@ to `compilation-error-regexp-alist' if RULES is nil." file line end-line col end-col (or type 2) fmt rule)) - (when (integerp file) + (when file (let ((this-type (if (consp type) (compilation-type type) (or type 2)))) commit 014a67200c777d0750f1a9070aab20560a718a5b Author: Mattias Engdegård Date: Sun Jul 18 17:28:24 2021 +0200 ; * test/lisp/progmodes/compile-tests.el: simplify end-col The internal representation of columns uses half-open intervals but don't expose that in the test cases, where we want to use the same numbers as in the compilation messages. diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index da6a1e641c..0623cec528 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -31,9 +31,6 @@ (require 'compile) (defconst compile-tests--test-regexps-data - ;; The computed column numbers are zero-indexed, so subtract 1 from - ;; what's reported in the string. The end column numbers are for - ;; the character after, so it matches what's reported in the string. '(;; absoft (absoft "Error on line 3 of t.f: Execution error unclassifiable statement" @@ -61,7 +58,7 @@ (ant "[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally" 13 nil 49 "/src/DataBaseTestCase.java" 1) (ant "[jikes] foo.java:3:5:7:9: blah blah" - 14 (5 . 10) (3 . 7) "foo.java" 2) + 14 (5 . 9) (3 . 7) "foo.java" 2) (ant "[javac] c:/cygwin/Test.java:12: error: foo: bar" 9 nil 12 "c:/cygwin/Test.java" 2) (ant "[javac] c:\\cygwin\\Test.java:87: error: foo: bar" @@ -86,10 +83,10 @@ ;; caml (python-tracebacks-and-caml "File \"foobar.ml\", lines 5-8, characters 20-155: blah blah" - 1 (20 . 156) (5 . 8) "foobar.ml") + 1 (20 . 155) (5 . 8) "foobar.ml") (python-tracebacks-and-caml "File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ." - 1 (2 . 146) 65 "F:\\ocaml\\sorting.ml") + 1 (2 . 145) 65 "F:\\ocaml\\sorting.ml") (python-tracebacks-and-caml "File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children" 1 nil 41 "/usr/share/gdesklets/display/TargetGauge.py") @@ -231,12 +228,12 @@ (gnu "foo.c:8.23: note: message" 1 23 8 "foo.c") (gnu "foo.c:8.23: info: message" 1 23 8 "foo.c") (gnu "foo.c:8:23:information: message" 1 23 8 "foo.c") - (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 46) (8 . nil) "foo.c") + (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 45) (8 . nil) "foo.c") (gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c") ;; The next one is not in the GNU standards AFAICS. ;; Here we seem to interpret it as LINE1-LINE2.COL2. - (gnu "foo.c:8-45.3: message" 1 (nil . 4) (8 . 45) "foo.c") - (gnu "foo.c:8.23-9.1: message" 1 (23 . 2) (8 . 9) "foo.c") + (gnu "foo.c:8-45.3: message" 1 (nil . 3) (8 . 45) "foo.c") + (gnu "foo.c:8.23-9.1: message" 1 (23 . 1) (8 . 9) "foo.c") (gnu "jade:dbcommon.dsl:133:17:E: missing argument for function call" 1 17 133 "dbcommon.dsl") (gnu "G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." @@ -472,8 +469,11 @@ can only work with the NUL byte to disambiguate colons.") (when file (should (equal (caar (compilation--loc->file-struct loc)) file))) (when end-col + ;; The computed END-COL is exclusive; subtract one to get the + ;; number in the error message. (should (equal - (car (cadr (nth 2 (compilation--loc->file-struct loc)))) + (1- (car (cadr + (nth 2 (compilation--loc->file-struct loc))))) end-col))) (should (equal (car (nth 2 (compilation--loc->file-struct loc))) (or end-line line))) commit 48dfaa734be15e22f2a30a8cac73353e4649ce0a Author: Lars Ingebrigtsen Date: Sun Jul 18 18:18:03 2021 +0200 Clarify event-convert-list doc string * src/keyboard.c (Fevent_convert_list): Clarify that the base type returned isn't always the same (bug#7631). diff --git a/src/keyboard.c b/src/keyboard.c index 6174a4aad9..77d6bbba62 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -6622,8 +6622,11 @@ DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0, EVENT-DESC should contain one base event type (a character or symbol) and zero or more modifier names (control, meta, hyper, super, shift, alt, drag, down, double or triple). The base must be last. -The return value is an event type (a character or symbol) which -has the same base event type and all the specified modifiers. */) + +The return value is an event type (a character or symbol) which has +essentially the same base event type and all the specified modifiers. +(Some compatibility base types, like symbols that represent a +character, are not returned verbatim.) */) (Lisp_Object event_desc) { Lisp_Object base = Qnil; commit 87a432455d7ddc466da55df1ade5a647511740b6 Author: Stephen Gildea Date: Sun Jul 18 08:38:37 2021 -0700 Add doc string to time-stamp-tests that didn't have one * test/lisp/time-stamp-tests.el (formatz-generate-tests, formatz-%z-spotcheck): Add doc strings to tests. diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index e42a58a168..0d64320496 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -904,17 +904,23 @@ the other expected results for hours greater than 99 with non-zero seconds." ert-test-list (list `(ert-deftest ,(intern (concat "formatz-" form-string "-hhmm")) () + ,(concat "Tests time-stamp format " form-string + " with whole hours or minutes.") (should (equal (formatz ,form-string (fz-make+zone 0)) ,(car hour-mod))) (formatz-hours-exact-helper ,form-string ',(cdr hour-mod)) (should (equal (formatz ,form-string (fz-make+zone 0 30)) ,(car mins-mod))) (formatz-nonzero-minutes-helper ,form-string ',(cdr mins-mod))) - `(ert-deftest ,(intern (concat "formatz-" form-string "-secs")) () + `(ert-deftest ,(intern (concat "formatz-" form-string "-seconds")) () + ,(concat "Tests time-stamp format " form-string + " with offsets that have non-zero seconds.") (should (equal (formatz ,form-string (fz-make+zone 0 0 30)) ,(car secs-mod))) (formatz-nonzero-seconds-helper ,form-string ',(cdr secs-mod))) - `(ert-deftest ,(intern (concat "formatz-" form-string "-big")) () + `(ert-deftest ,(intern (concat "formatz-" form-string "-threedigit")) () + ,(concat "Tests time-stamp format " form-string + " with offsets that are 100 hours or greater.") (should (equal (formatz ,form-string (fz-make+zone 100)) ,(car big-mod))) (formatz-hours-big-helper ,form-string ',(cdr big-mod)) @@ -954,6 +960,7 @@ the other expected results for hours greater than 99 with non-zero seconds." ;; The legacy exception for %z in time-stamp will need to remain ;; through at least 2024 and Emacs 28. (ert-deftest formatz-%z-spotcheck () + "Spot-checks internal implementation of time-stamp format %z." (should (equal (format-time-offset "%z" (fz-make+zone 0)) "+0000")) (should (equal (format-time-offset "%z" (fz-make+zone 0 30)) "+0030")) (should (equal (format-time-offset "%z" (fz-make+zone 0 0 30)) "+000030")) commit da200ab0491abe17cd98ad6363c1de4dbd704c0e Author: Lars Ingebrigtsen Date: Sun Jul 18 17:18:17 2021 +0200 Allow ignoring local variable values permanently * doc/lispref/variables.texi (File Local Variables): Document it. * lisp/files.el (ignored-local-variable-values): New user option (bug#5003). (hack-local-variables-confirm): Allow ignoring permanently. (hack-local-variables-filter): Ignore the permanently ignored variables. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 62c76f09c0..541b53fd35 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1995,6 +1995,16 @@ Doing so adds those variable/value pairs to file. @end defopt +@defopt ignored-local-variable-values +If there are some local variables that you always want to always +ignore, this variable can be used. It uses the same syntax as +@code{safe-local-variable-values}, but the variable/value pairs here +will always be ignored when handling local variables. As with that +variable, when Emacs queries the user about whether to obey a +file-local variable, the user can choose to ignore them permanently, +and that will alter this variable and save it to the user's custom file. +@end defopt + @defun safe-local-variable-p sym val This function returns non-@code{nil} if it is safe to give @var{sym} the value @var{val}, based on the above criteria. diff --git a/etc/NEWS b/etc/NEWS index 6e2d5cc9a6..611df3ae39 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2222,6 +2222,12 @@ This command, called interactively, toggles the local value of ** Miscellaneous ++++ +*** New user option 'ignored-local-variable-values'. +This is the opposite of 'safe-local-variable-values' -- it's an alist +of local variables (and accompanying values) that are to be ignored +when reading a local variable section from a file. + --- *** 'indent-tabs-mode' is now a global minor mode instead of just a variable. diff --git a/lisp/files.el b/lisp/files.el index d97c93e5c7..ce4521b8e6 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3437,7 +3437,19 @@ in order to initialize other data structure based on them.") (defcustom safe-local-variable-values nil "List variable-value pairs that are considered safe. Each element is a cons cell (VAR . VAL), where VAR is a variable -symbol and VAL is a value that is considered safe." +symbol and VAL is a value that is considered safe. + +Also see `ignored-local-variable-values'." + :risky t + :group 'find-file + :type 'alist) + +(defcustom ignored-local-variable-values nil + "List variable-value pairs that will be ignored. +Each element is a cons cell (VAR . VAL), where VAR is a variable +symbol and VAL is a value that will be ignored. + +Also see `safe-local-variable-values'." :risky t :group 'find-file :type 'alist) @@ -3592,7 +3604,9 @@ n -- to ignore the local variables list.") (if offer-save (insert " ! -- to apply the local variables list, and permanently mark these - values (*) as safe (in the future, they will be set automatically.)\n\n") + values (*) as safe (in the future, they will be set automatically.) +i -- to ignore the local variables list, and permanently mark these + values (*) as ignored\n\n") (insert "\n\n")) (dolist (elt all-vars) (cond ((member elt unsafe-vars) @@ -3616,16 +3630,24 @@ n -- to ignore the local variables list.") (pop-to-buffer buf '(display-buffer--maybe-at-bottom)) (let* ((exit-chars '(?y ?n ?\s)) (prompt (format "Please type %s%s: " - (if offer-save "y, n, or !" "y or n") + (if offer-save "y, n, ! or i" "y or n") (if (< (line-number-at-pos (point-max)) (window-body-height)) "" ", or C-v/M-v to scroll"))) char) - (if offer-save (push ?! exit-chars)) + (when offer-save + (push ?i exit-chars) + (push ?! exit-chars)) (setq char (read-char-choice prompt exit-chars)) - (when (and offer-save (= char ?!) unsafe-vars) - (customize-push-and-save 'safe-local-variable-values unsafe-vars)) + (when (and offer-save + (or (= char ?!) (= char ?i)) + unsafe-vars) + (customize-push-and-save + (if (= char ?!) + 'safe-local-variable-values + 'ignored-local-variable-values) + unsafe-vars)) (prog1 (memq char '(?! ?\s ?y)) (quit-window t))))))) @@ -3718,13 +3740,18 @@ If these settings come from directory-local variables, then DIR-NAME is the name of the associated directory. Otherwise it is nil." ;; Find those variables that we may want to save to ;; `safe-local-variable-values'. - (let (all-vars risky-vars unsafe-vars) + (let (all-vars risky-vars unsafe-vars ignored) (dolist (elt variables) (let ((var (car elt)) (val (cdr elt))) (cond ((memq var ignored-local-variables) ;; Ignore any variable in `ignored-local-variables'. nil) + ((seq-some (lambda (elem) + (and (eq (car elem) var) + (eq (cdr elem) val))) + ignored-local-variable-values) + nil) ;; Obey `enable-local-eval'. ((eq var 'eval) (when enable-local-eval commit 7075ebbf5b67e58d8270c0e3673133ac0586f8b5 Author: Michael Albinus Date: Sun Jul 18 16:58:52 2021 +0200 Make remote file locks more robust * lisp/net/tramp.el (tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region): Make file locks more robust. * test/lisp/net/tramp-tests.el (tramp-test39-make-lock-file-name): Rename and extend. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 8138d9a360..b081e5957a 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -549,14 +549,14 @@ But handle the case, if the \"test\" command is not available." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let (file-locked + (let ((file-locked (eq (file-locked-p lockname) t)) (curbuf (current-buffer)) (tmpfile (tramp-compat-make-temp-file filename))) ;; Lock file. (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) (file-remote-p lockname) - (not (eq (file-locked-p lockname) t))) + (not file-locked)) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. (tramp-compat-funcall 'lock-file lockname)) @@ -592,7 +592,7 @@ But handle the case, if the \"test\" command is not available." (current-time)))) ;; Unlock file. - (when (and file-locked (eq (file-locked-p lockname) t)) + (when file-locked ;; `unlock-file' exists since Emacs 28.1. (tramp-compat-funcall 'unlock-file lockname)) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4008c25d3a..4e4f5548e2 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1589,14 +1589,14 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let (file-locked + (let ((file-locked (eq (file-locked-p lockname) t)) (curbuf (current-buffer)) (tmpfile (tramp-compat-make-temp-file filename))) ;; Lock file. (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) (file-remote-p lockname) - (not (eq (file-locked-p lockname) t))) + (not file-locked)) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. (tramp-compat-funcall 'lock-file lockname)) @@ -1635,7 +1635,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (current-time)))) ;; Unlock file. - (when (and file-locked (eq (file-locked-p lockname) t)) + (when file-locked ;; `unlock-file' exists since Emacs 28.1. (tramp-compat-funcall 'unlock-file lockname)) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 99f4063988..c5b84a6e4e 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -295,12 +295,12 @@ arguments to pass to the OPERATION." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let (file-locked) + (let ((file-locked (eq (file-locked-p lockname) t))) ;; Lock file. (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) (file-remote-p lockname) - (not (eq (file-locked-p lockname) t))) + (not file-locked)) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. (tramp-compat-funcall 'lock-file lockname)) @@ -311,7 +311,7 @@ arguments to pass to the OPERATION." (tramp-flush-file-properties v localname)) ;; Unlock file. - (when (and file-locked (eq (file-locked-p lockname) t)) + (when file-locked ;; `unlock-file' exists since Emacs 28.1. (tramp-compat-funcall 'unlock-file lockname)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 736c7efd24..093335a77b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4463,7 +4463,7 @@ of." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let (file-locked + (let ((file-locked (eq (file-locked-p lockname) t)) (tmpfile (tramp-compat-make-temp-file filename)) (modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) @@ -4477,7 +4477,7 @@ of." ;; Lock file. (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) (file-remote-p lockname) - (not (eq (file-locked-p lockname) t))) + (not file-locked)) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. (tramp-compat-funcall 'lock-file lockname)) @@ -4515,7 +4515,7 @@ of." (tramp-set-file-uid-gid filename uid gid) ;; Unlock file. - (when (and file-locked (eq (file-locked-p lockname) t)) + (when file-locked ;; `unlock-file' exists since Emacs 28.1. (tramp-compat-funcall 'unlock-file lockname)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3dd22acea5..be4b4279b4 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2466,7 +2466,8 @@ This checks also `file-name-as-directory', `file-name-directory', "^\\'") tramp--test-messages)))))))) - ;; We do not test lockname here. See `tramp-test39-lock-file'. + ;; We do not test lockname here. See + ;; `tramp-test39-make-lock-file-name'. ;; Do not overwrite if excluded. (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always) @@ -5746,8 +5747,8 @@ Use direct async.") (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) ;; The functions were introduced in Emacs 28.1. -(ert-deftest tramp-test39-lock-file () - "Check `lock-file', `unlock-file' and `file-locked-p'." +(ert-deftest tramp-test39-make-lock-file-name () + "Check `make-lock-file-name', `lock-file', `unlock-file' and `file-locked-p'." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-ange-ftp-p))) ;; Since Emacs 28.1. @@ -5783,6 +5784,15 @@ Use direct async.") (with-no-warnings (lock-file tmp-name1)) (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) + ;; `save-buffer' removes the lock. + (with-temp-buffer + (set-visited-file-name tmp-name1) + (insert "foo") + (save-buffer)) + (should-not (with-no-warnings (file-locked-p tmp-name1))) + (with-no-warnings (lock-file tmp-name1)) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) + ;; A new connection changes process id, and also the ;; lockname contents. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) @@ -5838,8 +5848,7 @@ Use direct async.") (should-error (set-visited-file-name tmp-name1) :type 'file-locked))) - (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) - (should-not (file-exists-p tmp-name1))) + (should (stringp (with-no-warnings (file-locked-p tmp-name1))))) ;; Cleanup. (ignore-errors (delete-file tmp-name1)) commit 1bd012ce439382e1da49e711ac74ac0a07d05075 Author: Naofumi Yasufuku Date: Sun Jul 18 16:57:53 2021 +0200 Make remote file locks more robust. (Bug#49621) * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): Make file locks more robust. (Bug#49621) Copyright-paperwork-exempt: yes diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e6bd42a83a..8b4c78fe65 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3249,7 +3249,7 @@ implementation will be used." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let (file-locked + (let ((file-locked (eq (file-locked-p lockname) t)) (uid (or (tramp-compat-file-attribute-user-id (file-attributes filename 'integer)) (tramp-get-remote-uid v 'integer))) @@ -3260,7 +3260,7 @@ implementation will be used." ;; Lock file. (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) (file-remote-p lockname) - (not (eq (file-locked-p lockname) t))) + (not file-locked)) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. (tramp-compat-funcall 'lock-file lockname)) @@ -3481,7 +3481,7 @@ implementation will be used." (tramp-set-file-uid-gid filename uid gid)) ;; Unlock file. - (when (and file-locked (eq (file-locked-p lockname) t)) + (when file-locked ;; `unlock-file' exists since Emacs 28.1. (tramp-compat-funcall 'unlock-file lockname)) commit e77bd6e8bf0601029465f1af11bbef97ba2d1f49 Author: Lars Ingebrigtsen Date: Sun Jul 18 16:34:02 2021 +0200 Maintain a list of terminal buffers in the menu * lisp/term.el (term--update-term-menu): New function (bug#5641). (term-mode): Use it to list terminal buffers. diff --git a/lisp/term.el b/lisp/term.el index d41895ad3d..560549ece9 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -864,8 +864,30 @@ is buffer-local." ["Paging" term-pager-toggle :style toggle :selected term-pager-count :help "Toggle paging feature"])) +(defun term--update-term-menu (&optional force) + (when (and (lookup-key term-mode-map [menu-bar terminal]) + (or force (frame-or-buffer-changed-p))) + (let ((buffer-list + (seq-filter + (lambda (buffer) + (provided-mode-derived-p (buffer-local-value 'major-mode buffer) + 'term-mode)) + (buffer-list)))) + (easy-menu-change + '("Terminal") + "Terminal Buffers" + (mapcar + (lambda (buffer) + (vector (format "%s (%s)" (buffer-name buffer) + (abbreviate-file-name + (buffer-local-value 'default-directory buffer))) + (lambda () + (interactive) + (switch-to-buffer buffer)))) + buffer-list))))) + (easy-menu-define term-signals-menu - (list term-mode-map term-raw-map term-pager-break-map) + (list term-mode-map term-raw-map term-pager-break-map) "Signals menu for Term mode." '("Signals" ["BREAK" term-interrupt-subjob :active t @@ -1076,6 +1098,7 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq-local term-pending-delete-marker (make-marker)) (make-local-variable 'term-current-face) (term-ansi-reset) + (add-hook 'menu-bar-update-hook 'term--update-term-menu) (setq-local term-pending-frame nil) ;; Cua-mode's keybindings interfere with the term keybindings, disable it. (setq-local cua-mode nil) commit 595eddd848740bc132ae2bbdf630876114364f98 Author: Eli Zaretskii Date: Sun Jul 18 17:27:23 2021 +0300 Fix display of mode-line with bidi formatting controls * src/xdisp.c (face_before_or_after_it_pos): Reimplement the bidi iteration to find the character after the current in visual order. (Bug#49562) diff --git a/src/xdisp.c b/src/xdisp.c index 8f4dfa5430..50ab2f8e05 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4557,11 +4557,13 @@ face_before_or_after_it_pos (struct it *it, bool before_p) ptrdiff_t bufpos, charpos; int base_face_id; - /* No face change past the end of the string (for the case - we are padding with spaces). No face change before the - string start. */ + /* No face change past the end of the string (for the case we + are padding with spaces). No face change before the string + start. Ignore face changes before the first visible + character on this display line. */ if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string) - || (IT_STRING_CHARPOS (*it) == 0 && before_p)) + || (IT_STRING_CHARPOS (*it) == 0 && before_p) + || it->current_x <= it->first_visible_x) return it->face_id; if (!it->bidi_p) @@ -4580,51 +4582,47 @@ face_before_or_after_it_pos (struct it *it, bool before_p) } else { - if (before_p) - { - /* With bidi iteration, the character before the current - in the visual order cannot be found by simple - iteration, because "reverse" reordering is not - supported. Instead, we need to start from the string - beginning and go all the way to the current string - position, remembering the previous position. */ - /* Ignore face changes before the first visible - character on this display line. */ - if (it->current_x <= it->first_visible_x) - return it->face_id; - SAVE_IT (it_copy, *it, it_copy_data); - IT_STRING_CHARPOS (it_copy) = 0; - bidi_init_it (0, 0, FRAME_WINDOW_P (it_copy.f), &it_copy.bidi_it); + /* With bidi iteration, the character before the current in + the visual order cannot be found by simple iteration, + because "reverse" reordering is not supported. Instead, + we need to start from the string beginning and go all the + way to the current string position, remembering the + visually-previous position. We need to start from the + string beginning for the character after the current as + well, since the iterator state in IT may have been + pushed, and the bidi cache is no longer coherent with the + string's text. */ + SAVE_IT (it_copy, *it, it_copy_data); + IT_STRING_CHARPOS (it_copy) = 0; + bidi_init_it (0, 0, FRAME_WINDOW_P (it_copy.f), &it_copy.bidi_it); - do - { - charpos = IT_STRING_CHARPOS (it_copy); - if (charpos >= SCHARS (it->string)) - break; - bidi_move_to_visually_next (&it_copy.bidi_it); - } - while (IT_STRING_CHARPOS (it_copy) != IT_STRING_CHARPOS (*it)); - - RESTORE_IT (it, it, it_copy_data); + do + { + charpos = it_copy.bidi_it.charpos; + if (charpos >= SCHARS (it->string)) + break; + bidi_move_to_visually_next (&it_copy.bidi_it); } - else + while (it_copy.bidi_it.charpos != IT_STRING_CHARPOS (*it)); + + if (!before_p) { /* Set charpos to the string position of the character that comes after IT's current position in the visual order. */ int n = (it->what == IT_COMPOSITION ? it->cmp_it.nchars : 1); - - it_copy = *it; - /* If this is the first display element, + /* If this is the first string character, bidi_move_to_visually_next will deliver character at current position without moving, so we need to enlarge N. */ - if (it->bidi_it.first_elt) + if (it_copy.bidi_it.first_elt) n++; while (n--) bidi_move_to_visually_next (&it_copy.bidi_it); charpos = it_copy.bidi_it.charpos; } + + RESTORE_IT (it, it, it_copy_data); } eassert (0 <= charpos && charpos <= SCHARS (it->string)); commit 12a193f8769ceb205261bd5804f5e5c808866a4f Author: Michael Albinus Date: Sun Jul 18 15:57:41 2021 +0200 Fix problem in `shadow-define-literal-group' (Bug#49596) * lisp/shadowfile.el (shadow-make-fullname): HOST can also be a remote file name. Bug#49596. * test/lisp/shadowfile-tests.el (auth-source-save-behavior) (tramp-cache-read-persistent-data, tramp-persistency-file-name): Set them globally. (shadow-test06-literal-groups): Extend test. diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index f39f17329f..ec3a27b991 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -284,9 +284,13 @@ Argument can be a simple name, remote file name, or already a (defsubst shadow-make-fullname (hup &optional host name) "Make a Tramp style fullname out of HUP, a `tramp-file-name' structure. -Replace HOST, and NAME when non-nil." +Replace HOST, and NAME when non-nil. HOST can also be a remote file name." (let ((hup (copy-tramp-file-name hup))) - (when host (setf (tramp-file-name-host hup) host)) + (when host + (if (file-remote-p host) + (setq name (or name (and hup (tramp-file-name-localname hup))) + hup (tramp-dissect-file-name (file-remote-p host))) + (setf (tramp-file-name-host hup) host))) (when name (setf (tramp-file-name-localname hup) name)) (if (null (tramp-file-name-method hup)) (format diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 268bb64f24..c571dc3e14 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -69,12 +69,15 @@ (format "/mock::%s" temporary-file-directory))) "Temporary directory for Tramp tests.") -(setq password-cache-expiry nil +(setq auth-source-save-behavior nil + password-cache-expiry nil shadow-debug (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) - tramp-verbose 0 ;; When the remote user id is 0, Tramp refuses unsafe temporary files. tramp-allow-unsafe-temporary-files (or tramp-allow-unsafe-temporary-files noninteractive) + tramp-cache-read-persistent-data t ;; For auth-sources. + tramp-persistency-file-name nil + tramp-verbose 0 ;; On macOS, `temporary-file-directory' is a symlinked directory. temporary-file-directory (file-truename temporary-file-directory) shadow-test-remote-temporary-file-directory @@ -643,7 +646,9 @@ guaranteed by the originator of a cluster definition." (expand-file-name "shadowfile-tests" shadow-test-remote-temporary-file-directory)) - mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) + mocked-input + `(,cluster1 ,file1 ,cluster2 ,file2 + ,primary ,file1 ,(kbd "RET"))) (with-temp-buffer (set-visited-file-name file1) (call-interactively #'shadow-define-literal-group) @@ -657,7 +662,9 @@ guaranteed by the originator of a cluster definition." (should (member (format "/%s:%s" cluster1 (file-local-name file1)) (car shadow-literal-groups))) (should (member (format "/%s:%s" cluster2 (file-local-name file2)) - (car shadow-literal-groups)))) + (car shadow-literal-groups))) + ;; Bug#49596. + (should (member (concat primary file1) (car shadow-literal-groups)))) ;; Cleanup. (shadow--tests-cleanup)))) commit c112f73668f201e8799d265e05874007fec78ca1 Author: Lars Ingebrigtsen Date: Sun Jul 18 15:24:55 2021 +0200 Make indent-tabs-mode into a regular mode instead of just a variable * lisp/simple.el (indent-tabs-mode): Make into a minor mode (bug#6276). diff --git a/etc/NEWS b/etc/NEWS index f547e2531c..6e2d5cc9a6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2222,6 +2222,9 @@ This command, called interactively, toggles the local value of ** Miscellaneous +--- +*** 'indent-tabs-mode' is now a global minor mode instead of just a variable. + --- *** New user option 'save-place-abbreviate-file-names'. diff --git a/lisp/simple.el b/lisp/simple.el index 322693f631..6de2190221 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6682,6 +6682,10 @@ or \"mark.*active\" at the prompt." ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. :variable (default-value 'transient-mark-mode)) +(define-minor-mode indent-tabs-mode + "Toggle whether indentation can insert TAB characters." + :global t :group 'indent :variable indent-tabs-mode) + (defvar widen-automatically t "Non-nil means it is ok for commands to call `widen' when they want to. Some commands will do this in order to go to positions outside commit d2f9295a1fc0416760652b5e22f913c6ca2d80e6 Author: Lars Ingebrigtsen Date: Sun Jul 18 14:49:48 2021 +0200 Don't shorten comment padding if the padding isn't spaces * lisp/newcomment.el (comment-padright): Don't shorten non-space padding (bug#6822). (comment-padleft): Ditto. diff --git a/lisp/newcomment.el b/lisp/newcomment.el index a5bfb06795..57a52effd1 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -840,9 +840,13 @@ Ensure that `comment-normalize-vars' has been called before you use this." (make-string (min comment-padding (- (match-end 0) (match-end 1))) ?\s) - (substring comment-padding ;additional right padding - (min (- (match-end 0) (match-end 1)) - (length comment-padding)))))) + (if (not (string-match-p "\\`\\s-" comment-padding)) + ;; If the padding isn't spaces, then don't + ;; shorten the padding. + comment-padding + (substring comment-padding ;additional right padding + (min (- (match-end 0) (match-end 1)) + (length comment-padding))))))) ;; We can only duplicate C if the comment-end has multiple chars ;; or if comments can be nested, else the comment-end `}' would ;; be turned into `}}}' where only the first ends the comment @@ -876,9 +880,13 @@ Ensure that `comment-normalize-vars' has been called before you use this." ;; Only separate the left pad because we assume there is no right pad. (string-match "\\`\\s-*" str) (let ((s (substring str (match-end 0))) - (pad (concat (substring comment-padding - (min (- (match-end 0) (match-beginning 0)) - (length comment-padding))) + (pad (concat (if (not (string-match-p "\\`\\s-" comment-padding)) + ;; If the padding isn't spaces, then don't + ;; shorten the padding. + comment-padding + (substring comment-padding + (min (- (match-end 0) (match-beginning 0)) + (length comment-padding)))) (match-string 0 str))) (c (aref str (match-end 0))) ;the first non-space char of STR ;; We can only duplicate C if the comment-end has multiple chars commit 5ade22c2f89f85883232875c63fda70bb0a75c0d Author: Lars Ingebrigtsen Date: Sun Jul 18 14:31:09 2021 +0200 Fix an unlikely `copyright-find-copyright' problem * lisp/emacs-lisp/copyright.el (copyright-find-copyright): Make the copyright matcher more robust (bug#7179). diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 6ba2e7804b..d2e4891ace 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -144,11 +144,16 @@ This function sets the match-data that `copyright-update-year' uses." (with-demoted-errors "Can't update copyright: %s" ;; (1) Need the extra \\( \\) around copyright-regexp because we ;; goto (match-end 1) below. See note (2) below. - (copyright-re-search (concat "\\(" copyright-regexp - "\\)\\([ \t]*\n\\)?.*\\(?:" - copyright-names-regexp "\\)") - (copyright-limit) - t))) + (let ((regexp (concat "\\(" copyright-regexp + "\\)\\([ \t]*\n\\)?.*\\(?:" + copyright-names-regexp "\\)"))) + (when (copyright-re-search regexp (copyright-limit) t) + ;; We may accidentally have landed in the middle of a + ;; copyright line, so re-perform the search without the + ;; search. (Otherwise we may be inserting the new year in the + ;; middle of the list of years.) + (goto-char (match-beginning 0)) + (copyright-re-search regexp nil t))))) (defun copyright-find-end () "Possibly adjust the search performed by `copyright-find-copyright'. commit 90029c9dbea0a815c228369b85806f7daed9cfab Author: Mattias Engdegård Date: Sun Jul 18 13:33:30 2021 +0200 ; * etc/NEWS: Move entry to its right place. diff --git a/etc/NEWS b/etc/NEWS index 88d8fbe4b8..f547e2531c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1598,6 +1598,14 @@ case-insensitive matching of messages when the old behavior is required, but the recommended solution is to use a correctly matching regexp instead. +--- +*** New user option 'compilation-search-all-directories'. +When doing parallel builds, directories and compilation errors may +arrive in the "*compilation*" buffer out-of-order. If this variable is +non-nil (the default), Emacs will now search backwards in the buffer +for any directory the file with errors may be in. If nil, this won't +be done (and this restores how this previously worked). + --- *** Messages from ShellCheck are now recognized. @@ -2357,14 +2365,6 @@ doesn't turn on 'display-fill-column-indicator-mode' in special-mode buffers. This can be controlled by customizing the variable 'global-display-fill-column-indicator-modes'. ---- -*** New user option 'compilation-search-all-directories'. -When doing parallel builds, directories and compilation errors may -arrive in the "*compilation*" buffer out-of-order. If this variable is -non-nil (the default), Emacs will now search backwards in the buffer -for any directory the file with errors may be in. If nil, this won't -be done (and this restores how this previously worked). - +++ *** New user option 'next-error-message-highlight'. In addition to a fringe arrow, 'next-error' error may now optionally commit 6b802a08cabfb23bdf1f65faa2ee163d3efa820d Author: Lars Ingebrigtsen Date: Sat Jul 17 16:56:35 2021 +0200 Fix previous grep-file-at-point change * lisp/progmodes/grep.el (grep-file-at-point): Fix previous change. diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 370bdd5516..91c72a9429 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1348,7 +1348,7 @@ command before it's run." (defun grep-file-at-point (point) "Return the name of the file at POINT a `grep-mode' buffer. The returned file name is relative." - (when-let ((msg (get-text-property (point) 'compilation-message)) + (when-let ((msg (get-text-property point 'compilation-message)) (loc (compilation--message->loc msg))) (caar (compilation--loc->file-struct loc)))) commit 9ee418b7b95e20fa4d8ae585f33e9b5d9316bc99 Author: Lennart Borgman Date: Sat Jul 17 16:53:36 2021 +0200 Add new function 'grep-file-at-point' * lisp/progmodes/grep.el (grep-file-at-point): New function to return the file name at point (bug#8252). diff --git a/etc/NEWS b/etc/NEWS index 4bfb5b4d16..88d8fbe4b8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1153,6 +1153,11 @@ any directory names on the 'find' command lines end in a slash. This change is for better compatibility with old versions of non-GNU 'find', such as the one used on macOS. +--- +*** New utility function 'grep-file-at-point'. +This returns the name of the file at point (if any) in 'grep-mode' +buffers. + ** Help +++ diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 462ea51e2c..370bdd5516 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1345,6 +1345,13 @@ command before it's run." (grep-highlight-matches 'always)) (rgrep regexp files dir confirm))) +(defun grep-file-at-point (point) + "Return the name of the file at POINT a `grep-mode' buffer. +The returned file name is relative." + (when-let ((msg (get-text-property (point) 'compilation-message)) + (loc (compilation--message->loc msg))) + (caar (compilation--loc->file-struct loc)))) + ;;;###autoload (defalias 'rzgrep 'zrgrep) commit b4b0c219a15f31aecd43f81c9e87cdf4dca57e37 Author: Karthik Chikmagalur Date: Sat Jul 17 16:29:11 2021 +0200 Enhance pcomplete support for xargs * lisp/pcmpl-unix.el (pcomplete/xargs): Add support for completing xargs options, including the ability to distinguish them from the command xargs runs (bug#49603). Copyright-paperwork-exempt: yes diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index c1aaf829dc..e1d104f74f 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -82,7 +82,8 @@ being via `pcmpl-ssh-known-hosts-file'." ;;;###autoload (defun pcomplete/xargs () "Completion for `xargs'." - ;; FIXME: Add completion of xargs-specific arguments. + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (funcall pcomplete-default-completion-function))) (funcall pcomplete-command-completion-function) (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) pcomplete-default-completion-function))) commit 153c9d5ff4576b74ff9f9589f620c58d590862e8 Author: Lars Ingebrigtsen Date: Sat Jul 17 15:41:33 2021 +0200 Make 'n'/'p' work again in shortdoc after previous changes * lisp/emacs-lisp/shortdoc.el (shortdoc--goto-section): Adjust to changes in how the text properties are inserted in 22a5482ab6 (bug#49605). Also make into a regular function. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 3a32f63257..4beba1dbed 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1319,16 +1319,15 @@ Example: (define-derived-mode shortdoc-mode special-mode "shortdoc" "Mode for shortdoc.") -(defmacro shortdoc--goto-section (arg sym &optional reverse) - `(progn - (unless (natnump ,arg) - (setq ,arg 1)) - (while (< 0 ,arg) - (,(if reverse - 'text-property-search-backward - 'text-property-search-forward) - ,sym t) - (setq ,arg (1- ,arg))))) +(defun shortdoc--goto-section (arg sym &optional reverse) + (unless (natnump arg) + (setq arg 1)) + (while (> arg 0) + (funcall + (if reverse 'text-property-search-backward + 'text-property-search-forward) + sym nil t t) + (setq arg (1- arg)))) (defun shortdoc-next (&optional arg) "Move cursor to the next function. commit 109c27341e35fae778b95e0eb5d4d72927bf4ea8 Author: akater Date: Mon Jul 12 14:15:54 2021 +0000 EIEIO: Prevent excessive evaluation of :initform * lisp/emacs-lisp/eieio.el (initialize-instance): Do not evaluate initform of a slot when initarg for the slot is provided, according to the following secitons of CLHS: - Object Creation and Initialization - Initialization Arguments - Defaulting of Initialization Arguments - Rules for Initialization Arguments * test/lisp/emacs-lisp/eieio-etests/eieio-tests.el: Add corresponding tests Fix a typo diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1c8c372aae..b31ea42a99 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -53,6 +53,7 @@ (message eieio-version)) (require 'eieio-core) +(eval-when-compile (require 'subr-x)) ;;; Defining a new class @@ -740,31 +741,37 @@ Called from the constructor routine." "Construct the new object THIS based on SLOTS.") (cl-defmethod initialize-instance ((this eieio-default-superclass) - &optional slots) + &optional args) "Construct the new object THIS based on SLOTS. -SLOTS is a tagged list where odd numbered elements are tags, and +ARGS is a property list where odd numbered elements are tags, and even numbered elements are the values to store in the tagged slot. If you overload the `initialize-instance', there you will need to call `shared-initialize' yourself, or you can call `call-next-method' to have this constructor called automatically. If these steps are not taken, then new objects of your class will not have their values -dynamically set from SLOTS." - ;; First, see if any of our defaults are `lambda', and - ;; re-evaluate them and apply the value to our slots. +dynamically set from ARGS." (let* ((this-class (eieio--object-class this)) + (initargs args) (slots (eieio--class-slots this-class))) (dotimes (i (length slots)) - ;; For each slot, see if we need to evaluate it. + ;; For each slot, see if we need to evaluate its initform. (let* ((slot (aref slots i)) + (slot-name (eieio-slot-descriptor-name slot)) (initform (cl--slot-descriptor-initform slot))) - ;; Those slots whose initform is constant already have the right - ;; value set in the default-object. - (unless (macroexp-const-p initform) - ;; FIXME: We should be able to just do (aset this (+ i ) dflt)! - (eieio-oset this (cl--slot-descriptor-name slot) - (eval initform t)))))) - ;; Shared initialize will parse our slots for us. - (shared-initialize this slots)) + (unless (or (when-let ((initarg + (car (rassq slot-name + (eieio--class-initarg-tuples + this-class))))) + (plist-get initargs initarg)) + ;; Those slots whose initform is constant already have + ;; the right value set in the default-object. + (macroexp-const-p initform)) + ;; FIXME: Use `aset' instead of `eieio-oset', relying on that + ;; vector returned by `eieio--class-slots' + ;; should be congruent with the object itself. + (eieio-oset this slot-name (eval initform t)))))) + ;; Shared initialize will parse our args for us. + (shared-initialize this args)) (cl-defgeneric slot-missing (object slot-name _operation &optional _new-value) "Method invoked when an attempt to access a slot in OBJECT fails. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 11ffc115f7..3ec4234344 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -574,7 +574,21 @@ METHOD is the method that was attempting to be called." (setf (get-slot-3 eitest-t1) 'setf-emu) (should (eq (get-slot-3 eitest-t1) 'setf-emu)) ;; Roll back - (setf (get-slot-3 eitest-t1) 'emu)) + (setf (get-slot-3 eitest-t1) 'emu) + (defvar eieio-tests-initform-was-evaluated) + (defclass eieio-tests-initform-not-evaluated-when-initarg-is-present () + ((slot-with-initarg-and-initform + :initarg :slot-with-initarg-and-initform + :initform (setf eieio-tests-initform-was-evaluated t)))) + (setq eieio-tests-initform-was-evaluated nil) + (make-instance + 'eieio-tests-initform-not-evaluated-when-initarg-is-present) + (should eieio-tests-initform-was-evaluated) + (setq eieio-tests-initform-was-evaluated nil) + (make-instance + 'eieio-tests-initform-not-evaluated-when-initarg-is-present + :slot-with-initarg-and-initform t) + (should-not eieio-tests-initform-was-evaluated)) (defvar eitest-t2 nil) (ert-deftest eieio-test-26-default-inheritance () commit 24a8cc5e707affad345e085b6fe8c778559533f6 Author: Mattias Engdegård Date: Fri Jul 16 13:04:14 2021 +0200 Define revert-buffer-function for *Memory Report* * lisp/emacs-lisp/memory-report.el (memory-report): Allow the memory report buffer to be updated by pressing 'g'. diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index f4f03133b0..1125dde405 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -44,6 +44,8 @@ by counted more than once." (pop-to-buffer "*Memory Report*") (special-mode) (button-mode 1) + (setq-local revert-buffer-function (lambda (_ignore-auto _noconfirm) + (memory-report))) (setq truncate-lines t) (message "Gathering data...") (let ((reports (append (memory-report--garbage-collect) commit 4200f091b094740651f2ff7046feed0db9e98aa3 Author: Michael Albinus Date: Fri Jul 16 18:54:12 2021 +0200 ; Fix last change in files.el diff --git a/lisp/files.el b/lisp/files.el index 8ccf9a9c75..d97c93e5c7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -477,7 +477,6 @@ file it's locking, and it has the same name, but with \".#\" prepended." :type '(repeat (list (regexp :tag "Regexp") (string :tag "Replacement") (boolean :tag "Uniquify"))) - :initialize 'custom-initialize-delay :version "28.1") (defcustom remote-file-name-inhibit-locks nil commit 553ad9c9e8550416d38c50aa5ec188d0b4f4d5cf Author: Michael Albinus Date: Fri Jul 16 18:13:28 2021 +0200 Add lock-file-mode * doc/emacs/files.texi (Interlocking): * doc/lispref/files.texi (File Locks): * etc/NEWS: Add lock-file-mode. * lisp/files.el (lock-file-name-transforms) (remote-file-name-inhibit-locks): Move down. (lock-file-mode): New minor mode. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 54ffcd3caf..7edf4d2bbb 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -849,6 +849,10 @@ diff-buffer-with-file} command. @xref{Comparing Files}. You can prevent the creation of remote lock files by setting the variable @code{remote-file-name-inhibit-locks} to @code{t}. +@cindex lock-file-mode + The minor mode @code{lock-file-mode}, called interactively, toggles +the local value of @code{create-lockfiles} in the current buffer. + @node File Shadowing @subsection Shadowing Files @cindex shadow files diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 1f4049f715..c7e5537c10 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -826,6 +826,11 @@ You can prevent the creation of remote lock files by setting the variable @code{remote-file-name-inhibit-locks} to @code{t}. @end defopt +@deffn Command lock-file-mode +This command, called interactively, toggles the local value of +@code{create-lockfiles} in the current buffer. +@end deffn + @node Information about Files @section Information about Files @cindex file, information about diff --git a/etc/NEWS b/etc/NEWS index e18b3d04aa..4bfb5b4d16 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2191,6 +2191,22 @@ Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text. If the 'EMACS_TEST_VERBOSE' environment variable is set, failure summaries will include the failing condition. +** File Locks + ++++ +*** New user option 'lock-file-name-transforms'. +This option allows controlling where lock files are written. It uses +the same syntax as 'auto-save-file-name-transforms'. + ++++ +*** New user option 'remote-file-name-inhibit-locks'. +When non-nil, this option suppresses lock files for remote files. + ++++ +*** New minor mode 'lock-file-mode'. +This command, called interactively, toggles the local value of +'create-lockfiles' in the current buffer. + ** Miscellaneous --- @@ -2209,15 +2225,6 @@ will now restore the original order. This is like 'insert-buffer-substring', but works in the opposite direction. -+++ -*** New user option 'lock-file-name-transforms'. -This option allows controlling where lock files are written. It uses -the same syntax as 'auto-save-file-name-transforms'. - -+++ -*** New user option 'remote-file-name-inhibit-locks'. -When non-nil, this option suppresses lock files for remote files. - +++ *** New user option 'kill-transform-function'. This can be used to transform (and suppress) strings from entering the diff --git a/lisp/files.el b/lisp/files.el index 862982b71d..8ccf9a9c75 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -412,26 +412,6 @@ ignored." :initialize 'custom-initialize-delay :version "21.1") -(defcustom lock-file-name-transforms nil - "Transforms to apply to buffer file name before making a lock file name. -This has the same syntax as -`auto-save-file-name-transforms' (which see), but instead of -applying to auto-save file names, it's applied to lock file names. - -By default, a lock file is put into the same directory as the -file it's locking, and it has the same name, but with \".#\" prepended." - :group 'files - :type '(repeat (list (regexp :tag "Regexp") - (string :tag "Replacement") - (boolean :tag "Uniquify"))) - :version "28.1") - -(defcustom remote-file-name-inhibit-locks nil - "Whether to use file locks for remote files." - :group 'files - :version "28.1" - :type 'boolean) - (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.") (defcustom auto-save-visited-interval 5 @@ -485,6 +465,32 @@ If `silently', don't ask the user before saving." :type '(choice (const t) (const nil) (const silently)) :group 'abbrev) +(defcustom lock-file-name-transforms nil + "Transforms to apply to buffer file name before making a lock file name. +This has the same syntax as +`auto-save-file-name-transforms' (which see), but instead of +applying to auto-save file names, it's applied to lock file names. + +By default, a lock file is put into the same directory as the +file it's locking, and it has the same name, but with \".#\" prepended." + :group 'files + :type '(repeat (list (regexp :tag "Regexp") + (string :tag "Replacement") + (boolean :tag "Uniquify"))) + :initialize 'custom-initialize-delay + :version "28.1") + +(defcustom remote-file-name-inhibit-locks nil + "Whether to use file locks for remote files." + :group 'files + :version "28.1" + :type 'boolean) + +(define-minor-mode lock-file-mode + "Toggle file locking in the current buffer (Lock File mode)." + :version "28.1" + (setq-local create-lockfiles (and lock-file-mode t))) + (defcustom find-file-run-dired t "Non-nil means allow `find-file' to visit directories. To visit the directory, `find-file' runs `find-directory-functions'." commit 45cdc89986bb4ee60d7b64ee6ba0f717869aae5a Merge: d8d9504c5a 7ac411ae2c Author: Glenn Morris Date: Fri Jul 16 07:51:35 2021 -0700 Merge from origin/emacs-27 7ac411ae2c (origin/emacs-27) ; * src/data.c (Fcar, Fcdr): Doc fix. 0d9e1826f7 One more minor update of the Emacs manual for 19th printing 92616d30e0 ; Fix let-alist Texinfo markup c13acf8e34 ; * doc/emacs/mule.texi (International Chars): Mention 'de... commit d8d9504c5a9f1b6d22eae131334b981c65881f0e Author: Eli Zaretskii Date: Fri Jul 16 16:26:21 2021 +0300 ; Fix wording of recent changes in documentation * lisp/files.el (query-about-changed-file): * doc/emacs/files.texi (Visiting): * etc/NEWS: Fix the wording of a recent change. (Bug#10755) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index b57618fd50..54ffcd3caf 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -228,12 +228,13 @@ actually contains wildcard characters. You can disable the wildcard feature by customizing @code{find-file-wildcards}. @vindex query-about-changed-file - If you're asking to visit a file that's already in a buffer, but the -file has changed externally, Emacs will ask you whether you want to -re-load the file or not. If you set @code{query-about-changed-file} -to @code{nil}, Emacs won't query you, but instead just display the -buffer and issue a message telling you how to revert the buffer from -the file. + If you're asking to visit a file that's already visited in a buffer, +but the file has changed externally, Emacs normally asks you whether +you want to re-read the file from disk. But if you set +@code{query-about-changed-file} to @code{nil}, Emacs won't query you, +but will instead just display the buffer's contents before the +changes, and show an echo-area message telling you how to revert the +buffer from the file. @kindex C-x C-v @findex find-alternate-file diff --git a/etc/NEWS b/etc/NEWS index cfa6a4e55b..e18b3d04aa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -311,9 +311,10 @@ prompt, and how you can tweak the file size threshold. +++ ** New user option 'query-about-changed-file'. If non-nil (the default), users are prompted as before when -re-visiting a file that has changed externally. If nil, the user is -not prompted, but instead the buffer is opened, and the user is given -an instruction on how to revert the uffer. +re-visiting a file that has changed externally after it was visited +the first time. If nil, the user is not prompted, but instead the +buffer is opened with its contents before the change, and the user is +given instructions how to revert the buffer. +++ ** Improved support for terminal emulators that encode the Meta flag. diff --git a/lisp/files.el b/lisp/files.el index 253a289180..862982b71d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2154,12 +2154,13 @@ think it does, because \"free\" is pretty hard to define in practice." :type '(choice integer (const :tag "Never issue warning" nil))) (defcustom query-about-changed-file t - "If non-nil, query the user when opening a file that has changed. -This happens if the file is already visited in a buffer, and the -file has changed, and the user re-visits the file. + "If non-nil, query the user when re-visiting a file that has changed. +This happens if the file is already visited in a buffer, the +file was changed externally, and the user re-visits the file. -If nil, the user isn't prompted, but instead given a warning -after switching to the buffer." +If nil, don't prompt the user, but instead provide instructions for +reverting, after switching to the buffer with its contents before +the external changes." :group 'files :group 'find-file :version "28.1" commit 87862f7e31e38b82d0e5937e338b71dab1738430 Author: Lars Ingebrigtsen Date: Fri Jul 16 14:51:03 2021 +0200 Clarify emacsclient Options node in the Emacs manual * doc/emacs/misc.texi (emacsclient Options): Don't claim that emacsclient searches for a socket name (bug#13319). diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 3c11a39de9..12cd492b4b 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2031,7 +2031,7 @@ evaluation performed is for side-effect rather than result. Connect to the Emacs server named @var{server-name}. (This option is not supported on MS-Windows.) The server name is given by the variable @code{server-name} on the Emacs server. If this option is -omitted, @command{emacsclient} connects to the first server it finds. +omitted, @command{emacsclient} connects to the default socket. If you set @code{server-name} of the Emacs server to an absolute file name, give the same absolute file name as @var{server-name} to this option to instruct @command{emacsclient} to connect to that server. commit 9b601d8537422886250588fce22abc4e7ef6b100 Author: Lars Ingebrigtsen Date: Fri Jul 16 14:30:24 2021 +0200 Add new user option 'query-about-changed-file' * doc/emacs/files.texi (Visiting): Document it. * lisp/files.el (query-about-changed-file): New user option (bug#10775). (find-file-noselect): Use it. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 32a2f1bb81..b57618fd50 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -227,6 +227,14 @@ File Names}, for information on how to visit a file whose name actually contains wildcard characters. You can disable the wildcard feature by customizing @code{find-file-wildcards}. +@vindex query-about-changed-file + If you're asking to visit a file that's already in a buffer, but the +file has changed externally, Emacs will ask you whether you want to +re-load the file or not. If you set @code{query-about-changed-file} +to @code{nil}, Emacs won't query you, but instead just display the +buffer and issue a message telling you how to revert the buffer from +the file. + @kindex C-x C-v @findex find-alternate-file If you visit the wrong file unintentionally by typing its name diff --git a/etc/NEWS b/etc/NEWS index bec7f9fb04..cfa6a4e55b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -308,6 +308,13 @@ default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more about the different options to visit a file, how you can disable the prompt, and how you can tweak the file size threshold. ++++ +** New user option 'query-about-changed-file'. +If non-nil (the default), users are prompted as before when +re-visiting a file that has changed externally. If nil, the user is +not prompted, but instead the buffer is opened, and the user is given +an instruction on how to revert the uffer. + +++ ** Improved support for terminal emulators that encode the Meta flag. Some terminal emulators set the 8th bit of Meta characters, and then diff --git a/lisp/files.el b/lisp/files.el index 825aa1c3e8..253a289180 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2153,6 +2153,18 @@ think it does, because \"free\" is pretty hard to define in practice." :version "25.1" :type '(choice integer (const :tag "Never issue warning" nil))) +(defcustom query-about-changed-file t + "If non-nil, query the user when opening a file that has changed. +This happens if the file is already visited in a buffer, and the +file has changed, and the user re-visits the file. + +If nil, the user isn't prompted, but instead given a warning +after switching to the buffer." + :group 'files + :group 'find-file + :version "28.1" + :type 'boolean) + (declare-function x-popup-dialog "menu.c" (position contents &optional header)) (defun files--ask-user-about-large-file-help-text (op-type size) @@ -2335,6 +2347,14 @@ the various files." (message "Reverting file %s..." filename) (revert-buffer t t) (message "Reverting file %s...done" filename))) + ((not query-about-changed-file) + (message + (substitute-command-keys + "File %s changed on disk. \\[revert-buffer] to load new contents%s") + (file-name-nondirectory filename) + (if (buffer-modified-p buf) + " and discard your edits" + ""))) ((yes-or-no-p (if (string= (file-name-nondirectory filename) (buffer-name buf)) commit 561ef16fd096002860c4f38d93145ee5a9adb82e Author: Lars Ingebrigtsen Date: Fri Jul 16 13:59:42 2021 +0200 Fix lock-file-name-transforms build problem * lisp/files.el (lock-file-name-transforms): Remove custom-initialize-delay to fix build problem (bug#49507). diff --git a/lisp/files.el b/lisp/files.el index ad02d373fd..825aa1c3e8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -424,7 +424,6 @@ file it's locking, and it has the same name, but with \".#\" prepended." :type '(repeat (list (regexp :tag "Regexp") (string :tag "Replacement") (boolean :tag "Uniquify"))) - :initialize 'custom-initialize-delay :version "28.1") (defcustom remote-file-name-inhibit-locks nil commit 7176407c0127426fcaf28fe3c151156379a59209 Author: Eli Zaretskii Date: Fri Jul 16 14:30:12 2021 +0300 Fix wording in a recent ELisp manual change * doc/lispref/tips.texi (Coding Conventions): Fix wording in a recent change. (Bug#21440) diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index a35847a74d..8aa225a00c 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -168,12 +168,12 @@ follow the naming conventions for hooks. @xref{Hooks}. @item @cindex unloading packages, preparing for -@code{unload-feature} will normally undo normal changes done by -loading a feature (like adding adds functions to hooks). However, if -loading @var{feature} does something more complex, define a function -@code{@var{feature}-unload-function}, and make it undo any such -changes. @code{unload-feature} will run this function. -@xref{Unloading}. +Using @code{unload-feature} will undo the changes usually done by +loading a feature (like adding functions to hooks). However, if +loading @var{feature} does something unusual and more complex, you can +define a function named @code{@var{feature}-unload-function}, and make +it undo any such special changes. @code{unload-feature} will then +automatically run this function if it exists. @xref{Unloading}. @item It is a bad idea to define aliases for the Emacs primitives. Normally commit 8eba2b57ca518d691d7b7cbb7f5050ba3945342f Author: Lars Ingebrigtsen Date: Fri Jul 16 12:55:21 2021 +0200 Allow hiding variables in Customize * lisp/cus-edit.el (custom-toggle-hide-variable): Allow closing an option even if there are unsaved changes (bug#11655). diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index a8b2640b7d..980a1cc717 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2824,7 +2824,7 @@ the present value is saved to its :shown-value property instead." (list (widget-value (car-safe (widget-get widget :children))))) - (error "There are unsaved changes"))) + (message "Note: There are unsaved changes"))) (widget-put widget :documentation-shown nil) (widget-put widget :custom-state 'hidden)) (custom-redraw widget) commit 865535a24cd07efee3c2d323de6e9baae8bc817d Author: Remington Furman Date: Fri Jul 16 11:47:36 2021 +0200 Make `number-at-point' work for more hex numbers * lisp/thingatpt.el (number-at-point): Rewrite to actually catch the hex numbers (bug#49588). Copyright-paperwork-exempt: yes diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 8ca0f429ca..4c2470fbcb 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -677,14 +677,14 @@ Signal an error if the entire string was not used." "Return the number at point, or nil if none is found. Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers like \"0xBEEF09\" or \"#xBEEF09\", are recognized." - (when (thing-at-point-looking-at - "\\(-?[0-9]+\\.?[0-9]*\\)\\|\\(0x\\|#x\\)\\([a-zA-Z0-9]+\\)" 500) - (if (match-beginning 1) - (string-to-number - (buffer-substring (match-beginning 1) (match-end 1))) - (string-to-number - (buffer-substring (match-beginning 3) (match-end 3)) - 16)))) + (cond + ((thing-at-point-looking-at "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" 500) + (string-to-number + (buffer-substring (match-beginning 2) (match-end 2)) + 16)) + ((thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500) + (string-to-number + (buffer-substring (match-beginning 0) (match-end 0)))))) (put 'number 'thing-at-point 'number-at-point) ;;;###autoload diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index 07eb8bb250..fba6f21d5d 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -190,4 +190,37 @@ position to retrieve THING.") (goto-char 2) (should (eq (symbol-at-point) nil)))) +(defun test--number (number pos) + (with-temp-buffer + (insert (format "%s\n" number)) + (goto-char (point-min)) + (forward-char pos) + (number-at-point))) + +(ert-deftest test-numbers-none () + (should (equal (test--number "foo" 0) nil))) + +(ert-deftest test-numbers-decimal () + (should (equal (test--number "42" 0) 42)) + (should (equal (test--number "42" 1) 42)) + (should (equal (test--number "42" 2) 42))) + +(ert-deftest test-numbers-hex-lisp () + (should (equal (test--number "#x42" 0) 66)) + (should (equal (test--number "#x42" 1) 66)) + (should (equal (test--number "#x42" 2) 66)) + (should (equal (test--number "#xf00" 0) 3840)) + (should (equal (test--number "#xf00" 1) 3840)) + (should (equal (test--number "#xf00" 2) 3840)) + (should (equal (test--number "#xf00" 3) 3840))) + +(ert-deftest test-numbers-hex-c () + (should (equal (test--number "0x42" 0) 66)) + (should (equal (test--number "0x42" 1) 66)) + (should (equal (test--number "0x42" 2) 66)) + (should (equal (test--number "0xf00" 0) 3840)) + (should (equal (test--number "0xf00" 1) 3840)) + (should (equal (test--number "0xf00" 2) 3840)) + (should (equal (test--number "0xf00" 3) 3840))) + ;;; thingatpt.el ends here commit dc85ffffc88c08742072573539f8bfae9dcbbccb Author: Lars Ingebrigtsen Date: Fri Jul 16 10:56:21 2021 +0200 Clarify -unload-feature in Coding Conventions * doc/lispref/tips.texi (Coding Conventions): Clarify when an unload function is useful (bug#21440). diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 54cafffab3..a35847a74d 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -168,11 +168,12 @@ follow the naming conventions for hooks. @xref{Hooks}. @item @cindex unloading packages, preparing for -If loading the file adds functions to hooks, define a function -@code{@var{feature}-unload-function}, where @var{feature} is the name -of the feature the package provides, and make it undo any such -changes. Using @code{unload-feature} to unload the file will run this -function. @xref{Unloading}. +@code{unload-feature} will normally undo normal changes done by +loading a feature (like adding adds functions to hooks). However, if +loading @var{feature} does something more complex, define a function +@code{@var{feature}-unload-function}, and make it undo any such +changes. @code{unload-feature} will run this function. +@xref{Unloading}. @item It is a bad idea to define aliases for the Emacs primitives. Normally commit 1cd278bfcd7970ebe7f00ec5bd692ecea031ec6d Author: Lars Ingebrigtsen Date: Fri Jul 16 01:42:49 2021 +0200 Add a couple more shell-tests-split-string tests diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el index c4147088a2..223a18590b 100644 --- a/test/lisp/shell-tests.el +++ b/test/lisp/shell-tests.el @@ -54,6 +54,10 @@ '("ls" "/tmp/foo bar"))) (should (equal (split-string-shell-command "ls /tmp/'foo bar'") '("ls" "/tmp/foo bar"))) + (should (equal (split-string-shell-command "ls /tmp/'foo\"bar'") + '("ls" "/tmp/foo\"bar"))) + (should (equal (split-string-shell-command "ls /tmp/\"foo''bar\"") + '("ls" "/tmp/foo''bar"))) (should (equal (split-string-shell-command "ls /tmp/'foo\\ bar'") '("ls" "/tmp/foo\\ bar"))) (unless (memq system-type '(windows-nt ms-dos)) commit 653848a277ea887fd9f4dde382570ca6829a8608 Author: Glenn Morris Date: Thu Jul 15 13:19:48 2021 -0700 Improve recent jka-compr-compression-info-list change * lisp/jka-cmpr-hook.el (jka-compr-compression-info-list): Document previous change, and fix :type. diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index eadf5f0d50..6933a7c1d0 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -266,7 +266,7 @@ options through Custom does this automatically." Each element, which describes a compression technique, is a vector of the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS -APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where: +APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS UNCOMPRESS-FUNCTION], where: regexp is a regexp that matches filenames that are compressed with this format @@ -282,7 +282,7 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where: uncompress-msg is the message to issue to the user when doing this type of uncompression (nil means no message) - uncompress-program is a program that performs this compression + uncompress-program is a program that performs this uncompression uncompress-args is a list of args to pass to the uncompress program @@ -295,6 +295,9 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where: file-magic-chars is a string of characters that you would find at the beginning of a file compressed in this way. + uncompress-function is a function that performs uncompression, if + uncompress-program is not found. + If you set this outside Custom while Auto Compression mode is already enabled \(as it is by default), you have to call `jka-compr-update' after setting it to properly update other @@ -316,9 +319,12 @@ variables. Setting this through Custom does that automatically." (repeat :tag "Uncompress Arguments" string) (boolean :tag "Append") (boolean :tag "Strip Extension") - (string :tag "Magic Bytes"))) + (string :tag "Magic Bytes") + (choice :tag "Uncompress Function" + (symbol) + (const :tag "None" nil)))) :set 'jka-compr-set - :version "24.1" ; removed version extension piece + :version "28.1" ; add uncompress-function :group 'jka-compr) (defcustom jka-compr-mode-alist-additions commit f770538b30e5b55905617f293eb933b9d6e93ec1 Author: Tassilo Horn Date: Thu Jul 15 21:51:54 2021 +0200 Add bug-reference support for Codeberg projects * lisp/progmodes/bug-reference.el (bug-reference-setup-from-vc-alist): Add support for codeberg.org bug and pull request references. * doc/emacs/maintaining.texi (Bug Reference): Mention that bug and pull request references for codeberg projects are supported. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index a84af8535b..3205e6dbdf 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3134,10 +3134,10 @@ Setup for version-controlled files configurable by the variable setup GNU projects where @url{https://debbugs.gnu.org} is used as issue tracker and issues are usually referenced as @code{bug#13} (but many different notations are considered, too), Sourcehut projects -where issues are referenced using the notation @code{#17}, Github -projects where both bugs and pull requests are referenced using the -same notation, and GitLab projects where bugs are references with -@code{#17}, too, but merge requests use the @code{!18} notation. +where issues are referenced using the notation @code{#17}, Codeberg +and Github projects where both bugs and pull requests are referenced +using the same notation, and GitLab projects where bugs are referenced +with @code{#17}, too, but merge requests use the @code{!18} notation. @item Setup for email guessing from mail folder/mbox names, and mail header diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 918930a8af..755211b922 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -184,6 +184,22 @@ The second subexpression should match the bug reference (usually a number)." "/issues/" (match-string 2)))))) ;; + ;; Codeberg projects. + ;; + ;; The systematics is exactly as for Github projects. + ("[/@]codeberg.org[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" + "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (concat "https://codeberg.org/" + (or + ;; Explicit user/proj#18 link. + (match-string 1) + ns-project) + "/issues/" + (match-string 2)))))) + ;; ;; GitLab projects. ;; ;; Here #18 is an issue and !17 is a merge request. Explicit @@ -202,7 +218,6 @@ The second subexpression should match the bug reference (usually a number)." "issues/" "merge_requests/") (match-string 2)))))) - ;; ;; Sourcehut projects. ;; commit ec3b108c1f91f7adb25db46ae6aacddff762ed8a Author: Tassilo Horn Date: Thu Jul 15 21:43:29 2021 +0200 Add support for sourcehut to bug-reference.el * lisp/progmodes/bug-reference.el (bug-reference-setup-from-vc-alist): Add support for bug references like #17 and ~user/project#19 for sourcehut (sr.ht). * doc/emacs/maintaining.texi (Bug Reference): Document sourcehut support. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index a91bfacb9e..a84af8535b 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3132,10 +3132,12 @@ one is able to set the variables. Setup for version-controlled files configurable by the variable @code{bug-reference-setup-from-vc-alist}. The default is able to setup GNU projects where @url{https://debbugs.gnu.org} is used as -issue tracker, Github projects where both bugs and pull requests are -referenced using the @code{#42} notation, and GitLab projects where -bugs are references with @code{#17}, too, but merge requests use the -@code{!18} notation. +issue tracker and issues are usually referenced as @code{bug#13} (but +many different notations are considered, too), Sourcehut projects +where issues are referenced using the notation @code{#17}, Github +projects where both bugs and pull requests are referenced using the +same notation, and GitLab projects where bugs are references with +@code{#17}, too, but merge requests use the @code{!18} notation. @item Setup for email guessing from mail folder/mbox names, and mail header diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 61d722f5b9..918930a8af 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -201,6 +201,31 @@ The second subexpression should match the bug reference (usually a number)." (if (string= (match-string 3) "#") "issues/" "merge_requests/") + (match-string 2)))))) + + ;; + ;; Sourcehut projects. + ;; + ;; #19 is an issue. Other project's issues can be referenced as + ;; #~user/project#19. + ;; + ;; Caveat: The code assumes that a project on git.sr.ht or + ;; hg.sr.ht has a tracker of the same name on todo.sh.ht. That's + ;; a very common setup but all sr.ht services are loosely coupled, + ;; so you can have a repo without tracker, or a repo with a + ;; tracker using a different name, etc. So we can only try to + ;; make a good guess. + ("[/@]\\(?:git\\|hg\\).sr.ht[/:]\\(~[.A-Za-z0-9_/-]+\\)" + "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (concat "https://todo.sr.ht/" + (or + ;; Explicit user/proj#18 link. + (match-string 1) + ns-project) + "/" (match-string 2))))))) "An alist for setting up `bug-reference-mode' based on VC URL. commit eaefa44acd32f4f7d5e6357546ad22058495ee3f Author: Ori Date: Thu Jul 15 18:57:38 2021 +0200 ; * lisp/help-fns.el: Speed up `describe-mode' * lisp/help-fns.el (help-fns--list-local-commands): Speed up (bug#49579). A predicate checks if there are no key bindings for a given function. A full list of bindings is not needed, even a single binding is sufficient to say the function is bound. Set FIRSTONLY arg in where-is-internal so this predicate runs faster, with functional equivalence. For some configurations this has a noticeable improvement on the speed of describe-mode. Copyright-paperwork-exempt: yes diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d3fdb47a34..cb248b1d00 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1901,7 +1901,7 @@ documentation for the major and minor modes of that buffer." ;; Ignore aliases. (not (symbolp (symbol-function sym))) ;; Ignore everything bound. - (not (where-is-internal sym)) + (not (where-is-internal sym nil t)) (apply #'derived-mode-p (command-modes sym))) (push sym functions)))) (with-temp-buffer commit 8f5738eb8fc7556b69016976dfa810f7e6275bf8 Author: Lars Ingebrigtsen Date: Thu Jul 15 18:32:34 2021 +0200 Add more car/cdr examples to shortdoc * lisp/emacs-lisp/shortdoc.el (list): Add more car/cdr examples. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index dbf16967bc..3a32f63257 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -503,9 +503,13 @@ There can be any number of :example/:result elements." (flatten-tree :eval (flatten-tree '(1 (2 3) 4))) (car - :eval (car '(one two three))) + :eval (car '(one two three)) + :eval (car '(one . two)) + :eval (car nil)) (cdr - :eval (cdr '(one two three))) + :eval (cdr '(one two three)) + :eval (cdr '(one . two)) + :eval (cdr nil)) (last :eval (last '(one two three))) (butlast commit 22a5482ab699973e286d7dceb20fe469c94533dd Author: Lars Ingebrigtsen Date: Thu Jul 15 18:29:27 2021 +0200 Improve the shortdoc link action in *Help* buffers * lisp/emacs-lisp/shortdoc.el (shortdoc-display-group): Allow taking an optional parameter to place point on a specific function. (shortdoc--display-function): Go to the function in question in the shortdoc buffer. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 1d2c52454b..dbf16967bc 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1141,8 +1141,9 @@ There can be any number of :example/:result elements." :eval (sqrt -1))) ;;;###autoload -(defun shortdoc-display-group (group) - "Pop to a buffer with short documentation summary for functions in GROUP." +(defun shortdoc-display-group (group &optional function) + "Pop to a buffer with short documentation summary for functions in GROUP. +If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)." (interactive (list (completing-read "Show summary for functions in: " (mapcar #'car shortdoc--groups)))) (when (stringp group) @@ -1173,15 +1174,17 @@ There can be any number of :example/:result elements." (setq prev t) (shortdoc--display-function data)))) (cdr (assq group shortdoc--groups)))) - (goto-char (point-min))) + (goto-char (point-min)) + (when function + (text-property-search-forward 'shortdoc-function function t) + (beginning-of-line))) (defun shortdoc--display-function (data) (let ((function (pop data)) (start-section (point)) arglist-start) ;; Function calling convention. - (insert (propertize "(" - 'shortdoc-function t)) + (insert (propertize "(" 'shortdoc-function function)) (if (plist-get data :no-manual) (insert-text-button (symbol-name function) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index afdb0d17b2..d3fdb47a34 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -752,7 +752,7 @@ FILE is the file where FUNCTION was probably defined." (insert-text-button (symbol-name group) 'action (lambda (_) - (shortdoc-display-group group)) + (shortdoc-display-group group object)) 'follow-link t 'help-echo (purecopy "mouse-1, RET: show documentation group"))) groups) commit ceecac4c79df85a523a8a6bb3ace78105ff0ffe8 Author: Lars Ingebrigtsen Date: Thu Jul 15 18:03:36 2021 +0200 Add new user option to abbreviate file names in save-place * lisp/saveplace.el (save-place-abbreviate-file-names): New user option (bug#13286). (save-place-to-alist): Use it. diff --git a/etc/NEWS b/etc/NEWS index 6e5d358c95..bec7f9fb04 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2185,6 +2185,9 @@ summaries will include the failing condition. ** Miscellaneous +--- +*** New user option 'save-place-abbreviate-file-names'. + --- *** 'tabulated-list-mode' can now restore original display order. Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode', diff --git a/lisp/saveplace.el b/lisp/saveplace.el index f654702def..2a95b39da8 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -87,6 +87,11 @@ this happens automatically before saving `save-place-alist' to `save-place-file'." :type 'boolean) +(defcustom save-place-abbreviate-file-names nil + "If non-nil, abbreviate file names before saving them." + :type 'boolean + :version "28.1") + (defcustom save-place-save-skipped t "If non-nil, remember files matching `save-place-skip-check-regexp'. @@ -177,7 +182,10 @@ file: "Add current buffer filename and position to `save-place-alist'. Put filename and point in a cons box and then cons that onto the front of the `save-place-alist', if `save-place-mode' is non-nil. -Otherwise, just delete that file from the alist." +Otherwise, just delete that file from the alist. + +If `save-place-abbreviate-file-names' is non-nil, abbreviate the +file names." ;; First check to make sure alist has been loaded in from the master ;; file. If not, do so, then feel free to modify the alist. It ;; will be saved again when Emacs is killed. @@ -195,6 +203,8 @@ Otherwise, just delete that file from the alist." (or (not save-place-ignore-files-regexp) (not (string-match save-place-ignore-files-regexp item)))) + (when save-place-abbreviate-file-names + (setq item (abbreviate-file-name item))) (let ((cell (assoc item save-place-alist)) (position (cond ((eq major-mode 'hexl-mode) (with-no-warnings commit fbc9a509935f87e0627c3dba704108458f2b0389 Author: Lars Ingebrigtsen Date: Thu Jul 15 17:36:07 2021 +0200 Allow restoring the original order in 'tabulated-list-mode' * lisp/emacs-lisp/tabulated-list.el (tabulated-list-sort): Allow restoring the original order (bug#13411). (tabulated-list--sort-by-column-name): Store the original order. (tabulated-list--original-order): New buffer-local variable. diff --git a/etc/NEWS b/etc/NEWS index 3dfd9f1894..6e5d358c95 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2185,6 +2185,14 @@ summaries will include the failing condition. ** Miscellaneous +--- +*** 'tabulated-list-mode' can now restore original display order. +Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode', +and that mode allow the user to sort on any column. There was +previously no easy way to get back to the original displayed order +after sorting, but giving a -1 numerical prefix to the sorting command +will now restore the original order. + +++ *** New utility function 'insert-into-buffer'. This is like 'insert-buffer-substring', but works in the opposite diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 0b10dfdc0a..04f3b70aaa 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -36,6 +36,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup tabulated-list nil "Tabulated-list customization group." :group 'convenience @@ -645,18 +647,41 @@ this is the vector stored within it." (defun tabulated-list-sort (&optional n) "Sort Tabulated List entries by the column at point. -With a numeric prefix argument N, sort the Nth column." +With a numeric prefix argument N, sort the Nth column. + +If the numeric prefix is -1, restore order the list was +originally displayed in." (interactive "P") - (let ((name (if n - (car (aref tabulated-list-format n)) - (get-text-property (point) - 'tabulated-list-column-name)))) - (if (nth 2 (assoc name (append tabulated-list-format nil))) - (tabulated-list--sort-by-column-name name) - (user-error "Cannot sort by %s" name)))) + (if (equal n -1) + ;; Restore original order. + (progn + (unless tabulated-list--original-order + (error "Order is already in original order")) + (setq tabulated-list-entries + (sort tabulated-list-entries + (lambda (e1 e2) + (< (gethash e1 tabulated-list--original-order) + (gethash e2 tabulated-list--original-order))))) + (setq tabulated-list-sort-key nil) + (tabulated-list-init-header) + (tabulated-list-print t)) + ;; Sort based on a column name. + (let ((name (if n + (car (aref tabulated-list-format n)) + (get-text-property (point) + 'tabulated-list-column-name)))) + (if (nth 2 (assoc name (append tabulated-list-format nil))) + (tabulated-list--sort-by-column-name name) + (user-error "Cannot sort by %s" name))))) (defun tabulated-list--sort-by-column-name (name) (when (and name (derived-mode-p 'tabulated-list-mode)) + (unless tabulated-list--original-order + ;; Store the original order so that we can restore it later. + (setq tabulated-list--original-order (make-hash-table)) + (cl-loop for elem in tabulated-list-entries + for i from 0 + do (setf (gethash elem tabulated-list--original-order) i))) ;; Flip the sort order on a second click. (if (equal name (car tabulated-list-sort-key)) (setcdr tabulated-list-sort-key @@ -717,6 +742,8 @@ Interactively, N is the prefix numeric argument, and defaults to ;;; The mode definition: +(defvar tabulated-list--original-order nil) + (define-derived-mode tabulated-list-mode special-mode "Tabulated" "Generic major mode for browsing a list of items. This mode is usually not used directly; instead, other major @@ -757,6 +784,7 @@ as the ewoc pretty-printer." (setq-local glyphless-char-display (tabulated-list-make-glyphless-char-display-table)) (setq-local text-scale-remap-header-line t) + (setq-local tabulated-list--original-order nil) ;; Avoid messing up the entries' display just because the first ;; column of the first entry happens to begin with a R2L letter. (setq bidi-paragraph-direction 'left-to-right) commit 335a5fd173973e3f24daf5015fbf1177bfdebc40 Author: Protesilaos Stavrou Date: Thu Jul 15 17:20:07 2021 +0300 Update modus-themes to version 1.5.0 * doc/misc/modus-themes.org (Enable and load): Include internal link. (Sample configuration for use-package): Update code sample. (Customization Options): Update references to customization options. (Option for more italic constructs): Document new variable, as an alias of the deprecated 'modus-themes-slanted-constructs'. (Option for syntax highlighting, Option for links) (Option for command prompt styles, Option for mode line presentation) (Option for language checkers) (Option for line highlighting (hl-line-mode)) (Option for parenthesis matching (show-paren-mode)) (Option for active region, Option for the headings' overall style): Update documentation to describe new possible values, expressed as a list of symbols. (Option for Org agenda constructs): Document new user option. (Control the scale of headings): Update symbol of variable. (Remap face with local value (DIY), Backdrop for pdf-tools (DIY)): Tweak text of internal reference. (Font configurations for Org and others (DIY)): Add internal link and document how to configure the 'bold' and 'italic' faces. (Custom Org user faces (DIY)): Minor corrections or changes to single words. (Full support for packages or face groups): Include new items. (Notes on individual packages): Add notes on Avy hints, the colour of days in 'M-x calendar', and underlines in 'compilation-mode' buffers. (What is the best setup for legibility?): Remove single word. (Acknowledgements): Update list of contributors. * etc/themes/modus-themes.el (modus-themes-faces) (modus-themes-operandi-colors, modus-themes-vivendi-colors) (modus-themes-subtle-red, modus-themes-subtle-green) (modus-themes-subtle-yellow, modus-themes-subtle-blue) (modus-themes-subtle-magenta, modus-themes-subtle-cyan) (modus-themes-subtle-neutral, modus-themes-intense-red) (modus-themes-intense-green, modus-themes-intense-yellow) (modus-themes-intense-blue, modus-themes-intense-magenta) (modus-themes-intense-cyan, modus-themes-intense-neutral) (modus-themes-refine-red, modus-themes-refine-green) (modus-themes-refine-yellow, modus-themes-refine-blue) (modus-themes-refine-magenta, modus-themes-refine-cyan) (modus-themes-active-red, modus-themes-active-green) (modus-themes-active-yellow, modus-themes-active-blue) (modus-themes-active-magenta, modus-themes-active-cyan) (modus-themes-fringe-red, modus-themes-fringe-green) (modus-themes-fringe-yellow, modus-themes-fringe-blue) (modus-themes-fringe-magenta, modus-themes-fringe-cyan) (modus-themes-nuanced-red, modus-themes-nuanced-green) (modus-themes-nuanced-yellow, modus-themes-nuanced-blue) (modus-themes-nuanced-magenta, modus-themes-nuanced-cyan) (modus-themes-special-cold, modus-themes-special-mild) (modus-themes-special-warm, modus-themes-special-calm) (modus-themes-diff-added, modus-themes-diff-changed) (modus-themes-diff-removed, modus-themes-diff-refine-added) (modus-themes-diff-refine-changed, modus-themes-diff-refine-removed) (modus-themes-diff-focus-added, modus-themes-diff-focus-changed) (modus-themes-diff-focus-removed, modus-themes-diff-heading) (modus-themes-pseudo-header, modus-themes-mark-alt) (modus-themes-mark-del, modus-themes-mark-sel, modus-themes-mark-symbol) (modus-themes-heading-1, modus-themes-heading-2, modus-themes-heading-3) (modus-themes-heading-4, modus-themes-heading-5, modus-themes-heading-6) (modus-themes-heading-7, modus-themes-heading-8, modus-themes-hl-line) (modus-themes-bold, modus-themes-slant, modus-themes-variable-pitch) (modus-themes-graph-red-0, modus-themes-graph-red-1) (modus-themes-graph-green-0, modus-themes-graph-green-1) (modus-themes-graph-yellow-0, modus-themes-graph-yellow-1) (modus-themes-graph-blue-0, modus-themes-graph-blue-1) (modus-themes-graph-magenta-0, modus-themes-graph-magenta-1) (modus-themes-graph-cyan-0, modus-themes-graph-cyan-1) (modus-themes-lang-note, modus-themes-lang-warning) (modus-themes-lang-error, modus-themes-reset-soft) (modus-themes-reset-hard, modus-themes-key-binding) (modus-themes-search-success, modus-themes-search-success-modeline) (modus-themes-search-success-lazy): Add new ':group' specification for custom faces. (modus-themes-operandi-color-overrides) (modus-themes-vivendi-color-overrides, modus-themes-bold-constructs) (modus-themes-variable-pitch-headings, modus-themes-variable-pitch-ui) (modus-themes-no-mixed-fonts, modus-themes-fringes) (modus-themes-scale-headings, modus-themes-scale-1, modus-themes-scale-2) (modus-themes-scale-3, modus-themes-scale-4, modus-themes-scale-title) (modus-themes-org-blocks, modus-themes-completions) (modus-themes-success-deuteranopia, modus-themes-mail-citations) (modus-themes-subtle-line-numbers, modus-themes-intense-hl-line): Add custom setter. (modus-themes-scale-5, modus-themes-scale-title): Deprecate variable and replace it with alias 'modus-themes-scale-title'. (modus-themes-slanted-constructs, modus-themes-italic-constructs): Deprecate variable and replace it with alias 'modus-themes-italic-constructs'. (modus-themes-org-habit, modus-themes-org-agenda): Deprecate variable and make its functionality a part of 'modus-themes-org-agenda'. (modus-themes-headings, modus-themes-mode-line, modus-themes-diffs) (modus-themes-prompts, modus-themes-paren-match, modus-themes-syntax) (modus-themes-links, modus-themes-region, modus-themes-lang-checkers) (modus-themes-org-blocks): Make user options accept a value as a list of properties. (modus-themes--mixed-fonts, modus-themes--slant) (modus-themes--fixed-pitch, modus-themes--lang-check) (modus-themes--prompt, modus-themes--paren) (modus-themes--syntax-foreground, modus-themes--syntax-extra) (modus-themes--syntax-string, modus-themes--syntax-docstring) (modus-themes--syntax-comment, modus-themes--heading-p) (modus-themes--heading, modus-themes--org-habit) (modus-themes--mode-line-attrs, modus-themes--link-color) (modus-themes--link, modus-themes--region, modus-themes--hl-line): Update internal functions to parse new values for user options. * etc/themes/modus-operandi-theme.el, etc/themes/modus-vivendi-theme.el: Bump version number. A detailed change log is provided here (no javascript required): . diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 9b1a0014ca..5bb230f892 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -2,12 +2,12 @@ #+author: Protesilaos Stavrou #+email: info@protesilaos.com #+language: en -#+options: ':t toc:nil author:t email:t +#+options: ':t toc:nil author:t email:t num:t #+startup: content -#+macro: stable-version 1.4.0 -#+macro: release-date 2021-05-25 -#+macro: development-version 1.5.0-dev +#+macro: stable-version 1.5.0 +#+macro: release-date 2021-07-15 +#+macro: development-version 1.6.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -245,8 +245,11 @@ a theme with either of the following expressions: #+end_src Changes to the available customization options must always be evaluated -before loading a theme ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). This is how a basic -setup could look like: +before loading a theme ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). An exception to this +norm is when using the various Custom interfaces or with commands like +{{{kbd(M-x customize-set-variable)}}}, which automatically reload the theme by +default ([[#h:9001527a-4e2c-43e0-98e8-3ef72d770639][Option for inhibiting theme reload]]). This is how a basic setup +could look like: #+begin_src emacs-lisp (require 'modus-themes) @@ -294,9 +297,9 @@ package configurations in their setup. We use this as an example: :ensure ; omit this to use the built-in themes :init ;; Add all your customizations prior to loading the themes - (setq modus-themes-slanted-constructs t + (setq modus-themes-italic-constructs t modus-themes-bold-constructs nil - modus-themes-region 'no-extend) + modus-themes-region '(bg-only no-extend)) ;; Load the theme files before enabling a theme (else you get an error). (modus-themes-load-themes) @@ -366,7 +369,7 @@ configure custom faces, where ~load-theme~ is expected, though The Modus themes are highly configurable, though they should work well without any further tweaks. By default, all customization options are -set to nil. +set to nil, unless otherwise noted in this manual. Remember that all customization options must be evaluated before loading a theme ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). @@ -375,68 +378,78 @@ Below is a summary of what you will learn in the subsequent sections of this manual. #+begin_src emacs-lisp -(setq modus-themes-slanted-constructs t +(setq modus-themes-italic-constructs t modus-themes-bold-constructs nil modus-themes-no-mixed-fonts nil modus-themes-subtle-line-numbers nil modus-themes-success-deuteranopia t + modus-themes-inhibit-reload t ; only applies to `customize-set-variable' and related modus-themes-fringes nil ; {nil,'subtle,'intense} - ;; Options for `modus-themes-lang-checkers': nil, - ;; 'straight-underline, 'subtle-foreground, - ;; 'subtle-foreground-straight-underline, 'intense-foreground, - ;; 'intense-foreground-straight-underline, 'colored-background + ;; Options for `modus-themes-lang-checkers' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `straight-underline', `text-also', `background', + ;; `intense' modus-themes-lang-checkers nil - ;; Options for `modus-themes-mode-line': nil, '3d, 'moody, - ;; 'borderless, 'borderless-3d, 'borderless-moody, 'accented, - ;; 'accented-3d, 'accented-moody, 'borderless-accented, - ;; 'borderless-accented-3d, 'borderless-accented-moody - modus-themes-mode-line '3d + ;; Options for `modus-themes-mode-line' are either nil, or a list + ;; that can combine any of `3d' OR `moody', `borderless', + ;; `accented'. The variable's doc string shows all possible + ;; combinations. + modus-themes-mode-line '(3d accented) - ;; Options for `modus-themes-syntax': nil, 'faint, - ;; 'yellow-comments, 'green-strings, - ;; 'yellow-comments-green-strings, 'alt-syntax, - ;; 'alt-syntax-yellow-comments, 'faint-yellow-comments + ;; Options for `modus-themes-syntax' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `faint', `yellow-comments', `green-strings', `alt-syntax' modus-themes-syntax nil - ;; Options for `modus-themes-hl-line': nil, 'intense-background, - ;; 'accented-background, 'underline-neutral, - ;; 'underline-accented, 'underline-only-neutral, - ;; 'underline-only-accented - modus-themes-hl-line 'underline-neutral + ;; Options for `modus-themes-hl-line' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `accented', `underline', `intense' + modus-themes-hl-line '(underline accented) - modus-themes-paren-match 'subtle-bold ; {nil,'subtle-bold,'intense,'intense-bold} + ;; Options for `modus-themes-paren-match' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `bold', `intense', `underline' + modus-themes-paren-match '(bold intense) - ;; Options for `modus-themes-links': nil, 'faint, - ;; 'neutral-underline, 'faint-neutral-underline, 'no-underline, - ;; 'underline-only, 'neutral-underline-only - modus-themes-links 'neutral-underline + ;; Options for `modus-themes-links' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `neutral-underline' OR `no-underline', `faint' OR `no-color', + ;; `bold', `italic', `background' + modus-themes-links '(neutral-underline background) - ;; Options for `modus-themes-prompts': nil, 'subtle-accented, - ;; 'intense-accented, 'subtle-gray, 'intense-gray - modus-themes-prompts 'subtle-gray + ;; Options for `modus-themes-prompts' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `background', `bold', `gray', `intense', `italic' + modus-themes-prompts '(intense bold) modus-themes-completions 'moderate ; {nil,'moderate,'opinionated} modus-themes-mail-citations nil ; {nil,'faint,'monochrome} - ;; Options for `modus-themes-region': nil, 'no-extend, 'bg-only, - ;; 'bg-only-no-extend, 'accent, 'accent-no-extend - modus-themes-region 'bg-only-no-extend + ;; Options for `modus-themes-region' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `no-extend', `bg-only', `accented' + modus-themes-region '(bg-only no-extend) ;; Options for `modus-themes-diffs': nil, 'desaturated, ;; 'bg-only, 'deuteranopia, 'fg-only-deuteranopia modus-themes-diffs 'fg-only-deuteranopia modus-themes-org-blocks 'gray-background ; {nil,'gray-background,'tinted-background} - modus-themes-org-habit nil ; {nil,'simplified,'traffic-light} + + modus-themes-org-agenda ; this is an alist: read the manual or its doc string + '((header-block . (variable-pitch scale-title)) + (header-date . (grayscale workaholic bold-today)) + (scheduled . uniform) + (habit . traffic-light-deuteranopia)) modus-themes-headings ; this is an alist: read the manual or its doc string - '((1 . line) - (2 . rainbow-line-no-bold) - (t . no-bold)) + '((1 . (overline background)) + (2 . (rainbow overline)) + (t . (no-bold))) modus-themes-variable-pitch-ui nil modus-themes-variable-pitch-headings t @@ -445,9 +458,30 @@ this manual. modus-themes-scale-2 1.15 modus-themes-scale-3 1.21 modus-themes-scale-4 1.27 - modus-themes-scale-5 1.33) + modus-themes-scale-title 1.33) #+end_src +** Option for inhibiting theme reload +:properties: +:alt_title: Custom reload theme +:description: Toggle auto-reload of the theme when setting custom variables +:custom_id: h:9001527a-4e2c-43e0-98e8-3ef72d770639 +:end: +#+vindex: modus-themes-inhibit-reload + +Symbol: ~modus-themes-inhibit-reload~ + +Possible values: + +1. ~nil~ +2. ~t~ (default) + +By default, customizing a theme-related user option through the Custom +interfaces or with {{{kbd(M-x customize-set-variable)}}} will not reload the +currently active Modus theme. + +Enable this behaviour by setting this variable to ~nil~. + ** Option for color-coding success state (deuteranopia) :properties: :alt_title: Success' color-code @@ -501,26 +535,36 @@ weight. This concerns keywords and other important aspects of code syntax. It also affects certain mode line indicators and command-line prompts. -** Option for more slanted constructs +Advanced users may also want to configure the exact attributes of the +~bold~ face. + +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. + +** Option for more italic constructs :properties: -:alt_title: Slanted constructs -:description: Toggle slanted constructs (italics) in code +:alt_title: Italic constructs +:description: Toggle italic font constructs in code :custom_id: h:977c900d-0d6d-4dbb-82d9-c2aae69543d6 :end: -#+vindex: modus-themes-slanted-constructs +#+vindex: modus-themes-italic-constructs -Symbol: ~modus-themes-slanted-constructs~ +Symbol: ~modus-themes-italic-constructs~ Possible values: 1. ~nil~ (default) 2. ~t~ -The default is to not use slanted text (italics) unless it is absolutely -necessary. +The default is to not use slanted text forms (italics) unless it is +absolutely necessary. -With a non-nil value (~t~) choose to render more faces in slanted text. -This typically affects documentation strings and code comments. +With a non-nil value (~t~) choose to render more faces in italics. This +typically affects documentation strings and code comments. + +Advanced users may also want to configure the exact attributes of the +~italic~ face. + +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. ** Option for syntax highlighting :properties: @@ -532,44 +576,57 @@ This typically affects documentation strings and code comments. Symbol: ~modus-themes-syntax~ -Possible values: +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: -1. ~nil~ (default) -2. ~faint~ -3. ~yellow-comments~ -4. ~green-strings~ -5. ~yellow-comments-green-strings~ -6. ~alt-syntax~ -7. ~alt-syntax-yellow-comments~ -8. ~faint-yellow-comments~ - -The default style (nil) for code syntax highlighting is a balanced ++ ~faint~ ++ ~yellow-comments~ ++ ~green-strings~ ++ ~alt-syntax~ + +The default (a ~nil~ value or an empty list) is to use a balanced combination of colors on the cyan-blue-magenta side of the spectrum. -There is little to no use of greens, yellows, or reds, except when it is -necessary. +There is little to no use of greens, yellows, and reds. Comments are +gray, strings are blue colored, doc strings are a shade of cyan, while +color combinations are designed to avoid exaggerations. + +The property ~faint~ fades the saturation of all applicable colors, where +that is possible or appropriate. + +The property ~yellow-comments~ applies a yellow color to comments. -Option ~faint~ is like the default in terms of the choice of palette but -applies desaturated color values. +The property ~green-strings~ applies a green color to strings and a green +tint to doc strings. -Option ~yellow-comments~ adds a yellow tint to comments. The rest of the -syntax is the same as the default. +The property ~alt-syntax~ changes the combination of colors beyond strings +and comments, so that the effective palette is broadened to provide +greater variety relative to the default. -Option ~green-strings~ replaces the blue/cyan/cold color variants in -strings with greener alternatives. The rest of the syntax remains the -same. +Combinations of any of those properties are expressed as a list, like in +these examples: -Option ~yellow-comments-green-strings~ combines yellow comments with green -strings and the rest of the default syntax highlighting style. +#+begin_src emacs-lisp +(faint) +(green-strings yellow-comments) +(alt-syntax green-strings yellow-comments) +(faint alt-syntax green-strings yellow-comments) +#+end_src -Option ~alt-syntax~ expands the active spectrum by applying color -combinations with more contrasting hues between them. Expect to find -red and green variants in addition to cyan, blue, magenta. +The order in which the properties are set is not significant. -Option ~alt-syntax-yellow-comments~ combines ~alt-syntax~ with -~yellow-comments~. +In user configuration files the form may look like this: -Option ~faint-yellow-comments~ combines the ~faint~ style with -~yellow-comments~. +#+begin_src emacs-lisp +(setq modus-themes-syntax '(faint alt-syntax)) +#+end_src + +Independent of this variable, users may also control the use of a bold +weight or italic text: ~modus-themes-bold-constructs~ and +~modus-themes-italic-constructs~. + +[[#h:b25714f6-0fbe-41f6-89b5-6912d304091e][Option for more bold constructs]]. + +[[#h:977c900d-0d6d-4dbb-82d9-c2aae69543d6][Option for more italic constructs]]. ** Option for no font mixing :properties: @@ -611,43 +668,66 @@ are ~org-variable-pitch~ and ~mixed-pitch~. Symbol: ~modus-themes-links~ -Possible values: +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: -1. ~nil~ (default) -2. ~faint~ -3. ~neutral-underline~ -4. ~faint-neutral-underline~ -5. ~no-underline~ -6. ~underline-only~ -7. ~neutral-underline-only~ ++ Underline style: + - ~neutral-underline~ + - ~no-underline~ ++ Text coloration: + - ~faint~ + - ~no-color~ ++ ~bold~ ++ ~italic~ ++ ~background~ + +The default (a ~nil~ value or an empty list) is a prominent text color, +typically blue, with an underline of the same color. -The default style (nil) for links is to apply an underline and a -saturated color to the affected text. The color of the two is the same, -which makes the link fairly prominent. +For the style of the underline, a ~neutral-underline~ property turns the +color of the line into a subtle gray, while the ~no-underline~ property +removes the line altogether. If both of those are set, the latter takes +precedence. -Option ~faint~ follows the same approach as the default, but uses less -intense colors. +For text coloration, a ~faint~ property desaturates the color of the text +and the underline, unless the underline is affected by the +aforementioned properties. While a ~no-color~ property removes the color +from the text. If both of those are set, the latter takes precedence. -Option ~neutral-underline~ changes the underline's color to a subtle gray, -while retaining the default text color. +A ~bold~ property applies a heavy typographic weight to the text of the +link. -Option ~faint-neutral-underline~ combines a desaturated text color with a -subtle gray underline. +An ~italic~ property adds a slant to the link's text (italic or oblique +forms, depending on the typeface). -Option ~no-underline~ removes link underlines altogether, while retaining -their original fairly vivid color. +A ~background~ property applies a subtle tinted background color. -Option ~underline-only~ applies a prominent underline while making the -affected text colorless (it uses the same foreground as the theme's -default). +In case both ~no-underline~ and ~no-color~ are set, then a subtle gray +background is applied to all links. This can still be combined with the +~bold~ and ~italic~ properties. -Option ~neutral-underline-only~ makes the text colorless while using a -subtle gray underline below it. +Combinations of any of those properties are expressed as a list, +like in these examples: -NOTE: The placement of the underline, i.e. its proximity to the affected -text, is controlled by the built-in ~x-underline-at-descent-line~, -~x-use-underline-position-properties~, ~underline-minimum-offset~. Please -refer to their documentation strings. +#+begin_src emacs-lisp +(faint) +(no-underline faint) +(no-color no-underline bold) +(italic bold background no-color no-underline) +#+end_src + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-links '(neutral-underline background)) +#+end_src + +The placement of the underline, meaning its proximity to the text, is +controlled by ~x-use-underline-position-properties~, +~x-underline-at-descent-line~, ~underline-minimum-offset~. Please refer to +their documentation strings. ** Option for command prompt styles :properties: @@ -659,27 +739,51 @@ refer to their documentation strings. Symbol: ~modus-themes-prompts~ -Possible values: +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: -1. ~nil~ (default) -2. ~subtle-accented~ (~subtle~ exists for backward compatibility) -3. ~intense-accented~ (~intense~ exists for backward compatibility) -4. ~subtle-gray~ -5. ~intense-gray~ ++ ~background~ ++ ~bold~ ++ ~gray~ ++ ~intense~ ++ ~italic~ + +The default (a ~nil~ value or an empty list) means to only use a subtle +accented foreground color. + +The property ~background~ applies a background color to the prompt's text. +By default, this is a subtle accented value. -The default does not use any background for minibuffer and command line -prompts. It relies exclusively on an accented foreground color. +The property ~intense~ makes the foreground color more prominent. If the +~background~ property is also set, it amplifies the value of the +background as well. -Options ~subtle-accented~ and ~intense-accented~ will change both the -background and the foreground values to use accented color combinations -that follow the hue of the default styles' foreground (e.g. the default -minibuffer prompt is cyan text, so these combinations will involved a -cyan background and an appropriate cyan foreground). The difference -between the two is that the latter has a more pronounced/noticeable -effect than the former. +The property ~gray~ changes the prompt's colors to grayscale. This +affects the foreground and, if the ~background~ property is also set, the +background. Its effect is subtle, unless it is combined with the +~intense~ property. -Options ~subtle-gray~, ~intense-gray~ are like their accented counterparts, -except they use grayscale values. +The property ~bold~ makes the text use a bold typographic weight. +Similarly, ~italic~ adds a slant to the font's forms (italic or oblique +forms, depending on the typeface). + +Combinations of any of those properties are expressed as a list, like in +these examples: + +#+begin_src emacs-lisp +(intense) +(bold intense) +(intense bold gray) +(intense background gray bold) +#+end_src + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-prompts '(background gray)) +#+end_src ** Option for mode line presentation :properties: @@ -691,83 +795,78 @@ except they use grayscale values. Symbol: ~modus-themes-mode-line~ -Possible values: +Possible values, which can be expressed as a list of combinations of box +effect, color, and border visibility: -1. ~nil~ (default) -2. ~3d~ -3. ~moody~ -4. ~borderless~ -5. ~borderless-3d~ -6. ~borderless-moody~ -7. ~accented~ -8. ~accented-3d~ -9. ~accented-moody~ -10. ~borderless-accented~ -11. ~borderless-accented-3d~ -12. ~borderless-accented-moody~ - -The default produces a two-dimensional effect both for the active and -inactive mode lines. The differences between the two are limited to -distinct shades of grayscale values, with the active being more intense -than the inactive. - -Option ~3d~ will make the active mode line look like a three-dimensional -rectangle. Inactive mode lines remain 2D, though they are slightly -toned down relative to the default. This aesthetic is virtually the -same as what you get when you run Emacs without any customizations -(=emacs -Q= on the command line). - -While ~moody~ removes all box effects from the mode lines and applies -underline and overline properties instead. It also tones down a bit the -inactive mode lines. This is meant to optimize things for use with the -[[https://github.com/tarsius/moody][moody package]] (hereinafter referred to as "Moody"), though it can work -fine even without it. - -The ~borderless~ option uses the same colors as the default (nil value), -but removes the border effect. This is done by making the box property -use the same color as the background, effectively blending the two and -creating some padding. - -The ~borderless-3d~ and ~borderless-moody~ approximate the ~3d~ and ~moody~ -options respectively, while removing the borders. However, to ensure -that the inactive mode lines remain visible, they apply a slightly more -prominent background to them than what their counterparts do (same -inactive background as with the default). - -Similarly, ~accented~, ~accented-3d~, and ~accented-moody~ correspond to the -default (~nil~), ~3d~, and ~moody~ styles respectively, except that the active -mode line uses a colored background instead of the standard shade of -gray. - -Same principle for ~borderless-accented~, ~borderless-accented-3d~, and -~borderless-accented-moody~ which use a colored background for the active -mode line and have no discernible borders around both the active and -inactive the mode lines. ++ Overall style: + - ~3d~ + - ~moody~ ++ ~accented~ ++ ~borderless~ + +The default (a nil value or an empty list) is a two-dimensional +rectangle with a border around it. The active and the inactive +mode lines use different shades of grayscale values for the +background, foreground, border. + +The ~3d~ property applies a three-dimensional effect to the +active mode line. The inactive mode lines remain two-dimensional +and are toned down a bit, relative to the default style. + +The ~moody~ property optimizes the mode line for use with the +library of the same name (hereinafter referred to as 'Moody'). +In practice, it removes the box effect and replaces it with +underline and overline properties. It also tones down the +inactive mode lines. Despite its intended purpose, this option +can also be used without the Moody library (please consult the +themes' manual on this point for more details). If both ~3d~ and +~moody~ properties are set, the latter takes precedence. + +The ~borderless~ property removes the color of the borders. It +does not actually remove the borders, but only makes their color +the same as the background, effectively creating some padding. + +The ~accented~ property ensures that the active mode line uses a +colored background instead of the standard shade of gray. + +Combinations of any of those properties are expressed as a list, +like in these examples: + +#+begin_src emacs-lisp +(accented) +(borderless 3d) +(moody accented borderless) +#+end_src + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-prompts '(borderless accented)) +#+end_src Note that Moody does not expose any faces that the themes could style directly. Instead it re-purposes existing ones to render its tabs and ribbons. As such, there may be cases where the contrast ratio falls below the 7:1 target that the themes conform with (WCAG AAA). To hedge -against this, we configure a fallback foreground for the ~moody~ option, +against this, we configure a fallback foreground for the ~moody~ property, which will come into effect when the background of the mode line changes to something less accessible, such as Moody ribbons (read the doc string of ~set-face-attribute~, specifically ~:distant-foreground~). This fallback is activated when Emacs determines that the background and foreground of the given construct are too close to each other in terms of color -distance. In effect, users would need to experiment with the variable +distance. In practice, users will need to experiment with the variable ~face-near-same-color-threshold~ to trigger the effect. We find that a -value of =45000= will suffice, contrary to the default =30000=. Though for -the ~accented-moody~ value mentioned above, that should be raised up to -=70000=. Do not set it too high, because it has the adverse effect of -always overriding the default colors (which have been carefully designed -to be highly accessible). +value of =45000= shall suffice, contrary to the default =30000=. Though for +the combinations that involve the ~accented~ and ~moody~ properties, as +mentioned above, that should be raised up to =70000=. Do not set it too +high, because it has the adverse effect of always overriding the default +colors (which have been carefully designed to be highly accessible). Furthermore, because Moody expects an underline and overline instead of -a box style, it is advised you include this in your setup: - -#+begin_src emacs-lisp -(setq x-underline-at-descent-line t) -#+end_src +a box style, it is advised to set ~x-underline-at-descent-line~ to a +non-nil value. ** Option for completion framework aesthetics :properties: @@ -877,43 +976,55 @@ names imply. Symbol: ~modus-themes-lang-checkers~ -Possible values: +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: -1. ~nil~ (default) -2. ~subtle-foreground~ -3. ~intense-foreground~ -4. ~straight-underline~ -5. ~subtle-foreground-straight-underline~ -6. ~intense-foreground-straight-underline~ -7. ~colored-background~ - -Nil (the default) applies a color-coded underline to the affected text, -while it leaves the original foreground in tact. If the display spec -where Emacs runs in has support for it (e.g. Emacs GUI), the underline's -style is that of a wave, otherwise it is a straight line. - -Options ~subtle-foreground~ and ~intense-foreground~ follow the same -color-coding pattern and wavy underline of the default, while extending -it with a corresponding foreground value for the affected text. The -difference between the two options is one of degree, as their names -suggest. - -Option ~straight-underline~ is like the default but always applies a -straight line under the affected text. Same principle for -~subtle-foreground-straight-underline~ and its counterpart -~intense-foreground-straight-underline~. - -Option ~colored-background~ uses a straight underline, a tinted -background, and a suitable foreground. All are color-coded. This is -the most intense combination of face properties. - -The present variable affects packages and/or face groups such as those -of =flyspell=, =flymake=, =flycheck=, ~artbollocks-mode~, and ~writegood-mode~. ++ ~straight-underline~ ++ ~text-also~ ++ ~background~ ++ ~intense~ + +The default (a ~nil~ value or an empty list) applies a color-coded +underline to the affected text, while it leaves the original foreground +intact. If the display spec of Emacs has support for it, the +underline's style is that of a wave, otherwise it is a straight line. + +The property ~straight-underline~ ensures that the underline under the +affected text is always drawn as a straight line. + +The property ~text-also~ applies the same color of the underline to the +affected text. + +The property ~background~ adds a color-coded background. + +The property ~intense~ amplifies the applicable colors if ~background~ +and/or ~text-only~ are set. If ~intense~ is set on its own, then it implies +~text-only~. + +To disable fringe indicators for Flymake or Flycheck, refer to variables +~flymake-fringe-indicator-position~ and ~flycheck-indication-mode~, +respectively. + +Combinations of any of those properties can be expressed in a +list, as in those examples: + +#+begin_src emacs-lisp +(background) +(straight-underline intense) +(background text-also straight-underline) +#+end_src + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-lang-checkers '(text-also background)) +#+end_src NOTE: The placement of the straight underline, though not the wave -style, is controlled by the built-in ~x-underline-at-descent-line~, -~x-use-underline-position-properties~, ~underline-minimum-offset~. Please -refer to their documentation strings. +style, is controlled by the built-in variables ~underline-minimum-offset~, +~x-underline-at-descent-line~, ~x-use-underline-position-properties~. ** Option for line highlighting (hl-line-mode) :properties: @@ -925,43 +1036,47 @@ refer to their documentation strings. Symbol: ~modus-themes-hl-line~ -Possible values: +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: -1. ~nil~ (default) -2. ~intense-background~ -3. ~accented-background~ -4. ~underline-neutral~ -5. ~underline-accented~ -6. ~underline-only-neutral~ -7. ~underline-only-accented~ ++ ~accented~ ++ ~intense~ ++ ~underline~ -The default is to use a subtle gray background for the current line when -~hl-line-mode~ is enabled. +The default (a ~nil~ value or an empty list) is a subtle gray background +color. -The ~intense-background~ applies a more prominent gray to the background -of the current line. +The property ~accented~ changes the background to a colored variant. -With ~accented-background~ the background gets a colored hint and is more -prominent than the default. +An ~underline~ property draws a line below the highlighted area. Its +color is similar to the background, so gray by default or an accent +color when ~accented~ is also set. -The ~underline-neutral~ combines the default subtle neutral background -with a gray underline. +An ~intense~ property amplifies the colors in use, which may be both the +background and the underline. -Similarly, the ~underline-accented~ renders the background of the current -line in a subtle colored background, while it also draws an accented -underline. +Combinations of any of those properties are expressed as a list, like in +these examples: -Option ~underline-only-neutral~ produces a neutral underline, but does not -use any background. +#+begin_src emacs-lisp +(intense) +(underline intense) +(accented intense underline) +#+end_src -While ~underline-only-accented~ also uses just an underline, only this one -is colored. +The order in which the properties are set is not significant. -Consider setting the variable ~x-underline-at-descent-line~ to a non-nil -value for better results with underlines. +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-hl-line '(underline accented)) +#+end_src + +Set ~x-underline-at-descent-line~ to a non-nil value for better results +with underlines. This style affects several packages that enable ~hl-line-mode~, such as -=elfeed= and =mu4e=. +=elfeed=, =notmuch=, and =mu4e=. ** Option for line numbers (display-line-numbers-mode) :properties: @@ -1002,26 +1117,42 @@ updated to accommodate this aesthetic. Symbol: ~modus-themes-paren-match~ -Possible values: +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: -1. ~nil~ (default) -2. ~subtle-bold~ -3. ~intense~ -4. ~intense-bold~ ++ ~bold~ ++ ~intense~ ++ ~underline~ -Nil means to use a subtle tinted background color for the matching +The default (a ~nil~ value or an empty list) is a subtle background color. + +The ~bold~ property adds a bold weight to the characters of the matching delimiters. -Option ~intense~ applies a saturated background color. +The ~intense~ property applies a more prominent background color to the +delimiters. -Option ~subtle-bold~ is the same as the default, but also makes use of -bold typographic weight (inherits the ~bold~ face). +The ~underline~ property draws a straight line under the affected text. -Option ~intense-bold~ is the same as ~intense~, while it also uses a bold -weight. +Combinations of any of those properties are expressed as a list, like in +these examples: + +#+begin_src emacs-lisp +(bold) +(underline intense) +(bold intense underline) +#+end_src + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-paren-match '(bold intense)) +#+end_src -This customization variable affects tools such as the built-in -~show-paren-mode~ and the =smartparens= package. +This customization variable affects the built-in ~show-paren-mode~ and the +=smartparens= package. ** Option for active region :properties: @@ -1033,33 +1164,41 @@ This customization variable affects tools such as the built-in Symbol: ~modus-themes-region~ -Possible values: +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: -1. ~nil~ (default) -2. ~no-extend~ -3. ~bg-only~ -4. ~bg-only-no-extend~ -5. ~accent~ -6. ~accent-no-extend~ ++ ~no-extend~ ++ ~bg-only~ ++ ~accented~ -Nil means to only use a prominent gray background with a neutral -foreground. The foreground overrides all syntax highlighting. The -region extends to the edge of the window. +The default (a ~nil~ value or an empty list) is a prominent gray +background that overrides all foreground colors in the area it +encompasses. Its reach extends to the edge of the window. -Option ~no-extend~ preserves the default aesthetic but prevents the region -from extending to the edge of the window. +The ~no-extend~ property limits the region to the end of the line, so that +it does not reach the edge of the window. -Option ~bg-only~ applies a faint tinted background that is distinct from -all others used in the theme, while it does not override any existing -colors. It extends to the edge of the window. +The ~bg-only~ property makes the region's background color more subtle to +allow the underlying text to retain its foreground colors. -Option ~bg-only-no-extend~ is a combination of the ~bg-only~ and ~no-extend~ -options. +The ~accented~ property applies a more colorful background to the region. + +Combinations of any of those properties are expressed as a list, like in +these examples: -Option ~accent~ is like the default, though it uses a more colorful -background, while ~accent-no-extend~ is the same except it draws the -region only up to the end of each line instead of extending to the edge -of the window. +#+begin_src emacs-lisp +(no-extend) +(bg-only accented) +(accented bg-only no-extend) +#+end_src + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-region '(bg-only no-extend)) +#+end_src ** Option for diff buffer looks :properties: @@ -1148,169 +1287,238 @@ Older versions of the themes provided options ~grayscale~ (or ~greyscale~) and ~rainbow~. Those will continue to work as they are aliases for ~gray-background~ and ~tinted-background~, respectively. -** Option for org-habit graph styles +** Option for Org agenda constructs :properties: -:alt_title: Org agenda habits -:description: Choose among standard, simplified, or traffic light styles -:custom_id: h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2 +:alt_title: Org agenda +:description: Control each element in the presentation of the agenda +:custom_id: h:68f481bc-5904-4725-a3e6-d7ecfa7c3dbc :end: -#+vindex: modus-themes-org-habit +#+vindex: modus-themes-org-agenda -Symbol: ~modus-themes-org-habit~ +Symbol: ~modus-themes-org-agenda~ -Possible values: +This is an alist that accepts a =(key . value)= combination. Some values +are specified as a list. Here is a sample, followed by a description of +all possible combinations: -1. ~nil~ (default) -2. ~simplified~ -3. ~traffic-light~ - -The default is meant to conform with the original aesthetic of -=org-habit=. It employs all four color codes that correspond to the -org-habit states---clear, ready, alert, and overdue---while -distinguishing between their present and future variants. This results -in a total of eight colors in use: red, yellow, green, blue, in tinted -and shaded versions. They cover the full set of information provided by -the =org-habit= consistency graph. - -Option ~simplified~ is like the default except that it removes the -dichotomy between current and future variants by applying uniform -color-coded values. It applies a total of four colors: red, yellow, -green, blue. They produce a simplified consistency graph that is more -legible (or less "busy") than the default. The intent is to shift focus -towards the distinction between the four states of a habit task, rather -than each state's present/future outlook. - -Option ~traffic-light~ further reduces the available colors to red, -yellow, and green. As in ~simplified~, present and future variants appear -uniformly, but differently from it, the 'clear' state is rendered in a -green hue, instead of the original blue. This is meant to capture the -use-case where a habit task being "too early" is less important than it -being "too late". The difference between ready and clear states is -attenuated by painting both of them using shades of green. This option -thus highlights the alert and overdue states. +#+begin_src emacs-lisp +(setq modus-themes-org-agenda + '((header-block . (variable-pitch scale-title)) + (header-date . (grayscale workaholic bold-today)) + (scheduled . uniform) + (habit . traffic-light))) +#+end_src -** Option for the headings' overall style -:properties: -:alt_title: Heading styles -:description: Choose among several styles, also per heading level -:custom_id: h:271eff19-97aa-4090-9415-a6463c2f9ae1 -:end: -#+vindex: modus-themes-headings +A ~header-block~ key applies to elements that concern the headings which +demarcate blocks in the structure of the agenda. By default (a ~nil~ +value) those are rendered in a bold typographic weight, plus a height +that is slightly taller than the default font size. Acceptable values +come in the form of a list that can include either or both of those +properties: -This is defined as an alist and, therefore, uses a different approach -than other customization options documented in this manual. +- ~variable-pitch~ to use a proportionately spaced typeface; +- ~scale-title~ to increase the size to the number assigned to + ~modus-themes-scale-title~ ([[#h:6868baa1-beba-45ed-baa5-5fd68322ccb3][Control the scale of headings]]) or ~no-scale~ + to make the font use the same height as the rest of the buffer. -Symbol: ~modus-themes-headings~ +In case both ~scale-title~ and ~no-scale~ are in the list, the latter takes +precedence. -Possible values, which can be specified for each heading level N -(examples further below): +Example usage: -+ ~nil~ (~t~ is also available for backward compatibility) -+ ~no-bold~ -+ ~line~ -+ ~line-no-bold~ -+ ~rainbow~ -+ ~rainbow-line~ -+ ~rainbow-line-no-bold~ -+ ~highlight~ -+ ~highlight-no-bold~ -+ ~rainbow-highlight~ -+ ~rainbow-highlight-no-bold~ -+ ~section~ -+ ~section-no-bold~ -+ ~rainbow-section~ -+ ~rainbow-section-no-bold~ -+ ~no-color~ -+ ~no-color-no-bold~ - -To control faces per level from 1-8, use something like this: +#+begin_src emacs-lisp +(header-block . nil) +(header-block . (scale-title)) +(header-block . (no-scale)) +(header-block . (variable-pitch scale-title)) +#+end_src + +A ~header-date~ key covers date headings. Dates use only a foreground +color by default (a ~nil~ value), with weekdays and weekends having a +slight difference in hueness. The current date has an added gray +background. This key accepts a list of values that can include any of +the following properties: + +- ~grayscale~ to make weekdays use the main foreground color and + weekends a more subtle gray; +- ~workaholic~ to make weekdays and weekends look the same in + terms of color; +- ~bold-today~ to apply a bold typographic weight to the current + date; +- ~bold-all~ to render all date headings in a bold weight. + +For example: #+begin_src emacs-lisp -(setq modus-themes-headings - '((1 . section) - (2 . section-no-bold) - (3 . rainbow-line) - (t . rainbow-line-no-bold))) +(header-date . nil) +(header-date . (workaholic)) +(header-date . (grayscale bold-all)) +(header-date . (grayscale workaholic)) +(header-date . (grayscale workaholic bold-today)) #+end_src -The above uses the ~section~ value for heading levels 1, ~section-no-bold~ -for headings 2, ~rainbow-line~ for 3. All other levels fall back to -~rainbow-line-no-bold~. +A ~scheduled~ key applies to tasks with a scheduled date. By default (a +~nil~ value), those use varying shades of yellow to denote (i) a past or +current date and (ii) a future date. Valid values are symbols: + +- nil (default); +- ~uniform~ to make all scheduled dates the same color; +- ~rainbow~ to use contrasting colors for past, present, future + scheduled dates. -To set a uniform value for all heading levels, use this pattern: +For example: #+begin_src emacs-lisp -;; A given style for every heading -(setq modus-themes-headings - '((t . section))) +(scheduled . nil) +(scheduled . uniform) +(scheduled . rainbow) +#+end_src -;; Default aesthetic for every heading -(setq modus-themes-headings nil) +A ~habit~ key applies to the ~org-habit~ graph. All possible value are +passed as a symbol. Those are: + +- The default (~nil~) is meant to conform with the original aesthetic of + ~org-habit~. It employs all four color codes that correspond to the + org-habit states---clear, ready, alert, and overdue---while + distinguishing between their present and future variants. This + results in a total of eight colors in use: red, yellow, green, blue, + in tinted and shaded versions. They cover the full set of information + provided by the ~org-habit~ consistency graph. +- ~simplified~ is like the default except that it removes the dichotomy + between current and future variants by applying uniform color-coded + values. It applies a total of four colors: red, yellow, green, blue. + They produce a simplified consistency graph that is more legible (or + less busy) than the default. The intent is to shift focus towards the + distinction between the four states of a habit task, rather than each + state's present/future outlook. +- ~traffic-light~ further reduces the available colors to red, yellow, and + green. As in ~simplified~, present and future variants appear + uniformly, but differently from it, the ~clear~ state is rendered in a + green hue, instead of the original blue. This is meant to capture the + use-case where a habit task being too early is less important than it + being too late. The difference between ready and clear states is + attenuated by painting both of them using shades of green. This + option thus highlights the alert and overdue states. +- ~traffic-light-deuteranopia~ is like the ~traffic-light~ except its three + colors are red, yellow, and blue to be suitable for users with + red-green color deficiency (deuteranopia). + +For example: + +#+begin_src emacs-lisp +(habit . nil) +(habit . simplified) +(habit . traffic-light) #+end_src -The default style for headings uses a fairly desaturated foreground -color in combination with bold typographic weight. To specify this -style for a given level N, assuming you wish to have another fallback -option, just assign the value ~nil~ like this: +Putting it all together, the alist can look like this: + +#+begin_src emacs-lisp +'((header-block . (scale-title variable-pitch)) + (header-date . (grayscale workaholic bold-today)) + (scheduled . uniform) + (habit . traffic-light)) + +;; Or else: +(setq modus-themes-org-agenda + '((header-block . (scale-title variable-pitch)) + (header-date . (grayscale workaholic bold-today)) + (scheduled . uniform) + (habit . traffic-light))) +#+end_src + +** Option for the headings' overall style +:properties: +:alt_title: Heading styles +:description: Choose among several styles, also per heading level +:custom_id: h:271eff19-97aa-4090-9415-a6463c2f9ae1 +:end: +#+vindex: modus-themes-headings + +Symbol: ~modus-themes-headings~ + +This is an alist that accepts a =(key . list-of-values)= combination. The +key is either a number, representing the heading's level or ~t~, which +pertains to the fallback style. The list of values covers symbols that +refer to properties, as described below. Here is a sample, followed by +a presentation of all available properties: #+begin_src emacs-lisp (setq modus-themes-headings - '((1 . nil) - (2 . line) - (3) ; same as nil - (t . rainbow-line-no-bold))) + '((1 . (background overline)) + (2 . (overline rainbow)) + (t . (monochrome)))) #+end_src -A description of all other possible styles beyond the default: +Properties: -+ ~no-bold~ retains the default text color while removing the bold - typographic weight. ++ ~rainbow~ ++ ~overline~ ++ ~background~ ++ ~no-bold~ ++ ~monochrome~ -+ ~line~ is the same as the default plus an overline across the - heading's length. +By default (a ~nil~ value for this variable), all headings have a bold +typographic weight and use a desaturated text color. -+ ~line-no-bold~ is the same as ~line~ without bold weight. +A ~rainbow~ property makes the text color more saturated. -+ ~rainbow~ uses a more colorful foreground in combination with bold - typographic weight. +An ~overline~ property draws a line above the area of the heading. -+ ~rainbow-line~ is the same as ~rainbow~ plus an overline. +A ~background~ property adds a subtle tinted color to the background of +the heading. -+ ~rainbow-line-no-bold~ is the same as ~rainbow-line~ without the bold - weight. +A ~no-bold~ property removes the bold weight from the heading's text. -+ ~highlight~ retains the default style of a fairly desaturated - foreground combined with a bold weight and adds to it a subtle - accented background. +A ~monochrome~ property makes all headings the same base color, which is +that of the default for the active theme (black/white). When ~background~ +is also set, ~monochrome~ changes its color to gray. If both ~monochrome~ +and ~rainbow~ are set, the former takes precedence. -+ ~highlight-no-bold~ is the same as ~highlight~ without a bold weight. +Combinations of any of those properties are expressed as a list, like in +these examples: -+ ~rainbow-highlight~ is the same as ~highlight~ but with a more - colorful foreground. +#+begin_src emacs-lisp +(no-bold) +(rainbow background) +(overline monochrome no-bold) +#+end_src -+ ~rainbow-highlight-no-bold~ is the same as ~rainbow-highlight~ without - a bold weight. +The order in which the properties are set is not significant. -+ ~section~ retains the default looks and adds to them both an overline - and a slightly accented background. It is, in effect, a combination - of the ~line~ and ~highlight~ values. +In user configuration files the form may look like this: -+ ~section-no-bold~ is the same as ~section~ without a bold weight. +#+begin_src emacs-lisp +(setq modus-themes-headings + '((1 . (background overline rainbow)) + (2 . (background overline)) + (t . (overline no-bold)))) +#+end_src -+ ~rainbow-section~ is the same as ~section~ but with a more colorful - foreground. +When defining the styles per heading level, it is possible to pass a +non-nil value (~t~) instead of a list of properties. This will retain the +original aesthetic for that level. For example: -+ ~rainbow-section-no-bold~ is the same as ~rainbow-section~ without a - bold weight. +#+begin_src emacs-lisp +(setq modus-themes-headings + '((1 . t) ; keep the default style + (2 . (background overline)) + (t . (rainbow)))) ; style for all other headings -+ ~no-color~ does not apply any color to the heading, meaning that it - uses the foreground of the ~default~ face. It still renders the text - with a bold typographic weight. +(setq modus-themes-headings + '((1 . (background overline)) + (2 . (rainbow no-bold)) + (t . t))) ; default style for all other levels +#+end_src -+ ~no-color-no-bold~ is like ~no-color~ but without the bold weight. +For Org users, the extent of the heading depends on the variable +~org-fontify-whole-heading-line~. This affects the ~overline~ and +~background~ properties. Depending on the version of Org, there may be +others, such as ~org-fontify-done-headline~. -Remember to also inspect relevant variables that Org provides, such as: -~org-fontify-whole-heading-line~ and ~org-fontify-done-headline~. +[[#h:075eb022-37a6-41a4-a040-cc189f6bfa1f][Option for scaled headings]]. + +[[#h:97caca76-fa13-456c-aef1-a2aa165ea274][Option for variable-pitch font in headings]]. ** Option for scaled headings :properties: @@ -1366,7 +1574,7 @@ resource for finding a consistent scale: modus-themes-scale-2 1.1 modus-themes-scale-3 1.15 modus-themes-scale-4 1.2 - modus-themes-scale-5 1.3) + modus-themes-scale-title 1.3) #+end_src As for the application of that scale, the variables that range from @@ -1376,19 +1584,20 @@ smallest, while the latter is the largest. "Regular headings" are those that have a standard syntax for their scale, such as Org mode's eight levels of asterisks or Markdown's six columns. -Whereas ~modus-themes-scale-5~ is applied to special headings that do not -conform with the aforementioned syntax, yet which are expected to be -larger than the largest value on that implied scale. Put concretely, -Org's =#+title= meta datum is not part of the eight levels of headings in -an Org file, yet is supposed to signify the primary header. Similarly, -the Org Agenda's structure headings are not part of a recognisable scale -and so they also get ~modus-themes-scale-5~. +Whereas ~modus-themes-scale-title~ is applied to special headings that do +not conform with the aforementioned syntax, yet which are expected to be +larger than the largest value on that implied scale or at least have +some unique purpose in the buffer. Put concretely, Org's =#+title= meta +datum is not part of the eight levels of headings in an Org file, yet is +supposed to signify the primary header. Similarly, the Org Agenda's +structure headings are not part of a recognisable scale and so they also +get ~modus-themes-scale-title~ ([[#h:68f481bc-5904-4725-a3e6-d7ecfa7c3dbc][Option for Org agenda constructs]]). Users who wish to maintain scaled headings for the normal syntax while preventing special headings from standing out, can assign a value of =1.0= -to ~modus-themes-scale-5~ to make it the same as body text (or whatever -value would render it indistinguishable from the desired point of -reference). +to ~modus-themes-scale-title~ to make it the same as body text (or +whatever value would render it indistinguishable from the desired point +of reference). Note that in earlier versions of Org, scaling would only increase the size of the heading, but not of keywords that were added to it, like @@ -1727,7 +1936,7 @@ activates ~hl-line-mode~, but we wish to keep it distinct from other buffers. This is where ~face-remap-add-relative~ can be applied and may be combined with ~modus-themes-with-colors~ to deliver consistent results. -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette (DIY)]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. In this example we will write a simple interactive function that adjusts the background color of the ~region~ face. This is the sample code: @@ -2216,6 +2425,11 @@ reading the doc string of ~set-face-attribute~): (set-face-attribute 'fixed-pitch nil :family "DejaVu Sans Mono" :height 1.0) #+end_src +The next section shows how to make those work in a more elaborate setup +that is robust to changes between the Modus themes. + +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. + Note the differences in the ~:height~ property. The ~default~ face must specify an absolute value, which is the point size × 10. So if you want to use a font at point size =11=, you set the height to =110=.[fn:: ~:height~ @@ -2230,6 +2444,98 @@ base font size (i.e. the ~default~ face's absolute height). [[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts (SHR fonts)]]. +** Configure bold and italic faces (DIY) +:properties: +:custom_id: h:2793a224-2109-4f61-a106-721c57c01375 +:end: +#+cindex: Bold and italic fonts + +The Modus themes do not hardcode a ~:weight~ or ~:slant~ attribute in the +thousands of faces they cover. Instead, they configure the generic +faces called ~bold~ and ~italic~ to use the appropriate styles and then +instruct all relevant faces that require emphasis to inherit from them. + +This practically means that users can change the particularities of what +it means for a construct to be bold/italic, by tweaking the ~bold~ and +~italic~ faces. Cases where that can be useful include: + ++ The default typeface does not have a variant with slanted glyphs + (e.g. Fira Mono/Code as of this writing on 2021-07-07), so the user + wants to add another family for the italics, such as Hack. + ++ The typeface of choice provides a multitude of weights and the user + prefers the light one by default. To prevent the bold weight from + being too heavy compared to the light one, they opt to make ~bold~ use a + semibold weight. + ++ The typeface distinguishes between oblique and italic forms by + providing different font variants (the former are just slanted + versions of the upright forms, while the latter have distinguishing + features as well). In this case, the user wants to specify the font + that applies to the ~italic~ face. + +To achieve those effects, one must first be sure that the fonts they use +have support for those features. It then is a matter of following the +instructions for all face tweaks. + +[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. + +In this example, we set the default font family to Fira Code, while we +choose to render italics in the Hack typeface (obviously you need to +pick fonts that work well together): + +#+begin_src emacs-lisp +(set-face-attribute 'default nil :family "Fira Code" :height 110) +(set-face-attribute 'italic nil :family "Hack") +#+end_src + +And here we play with different weights, using Source Code Pro: + +#+begin_src emacs-lisp +(set-face-attribute 'default nil :family "Source Code Pro" :height 110 :weight 'light) +(set-face-attribute 'bold nil :weight 'semibold) +#+end_src + +To reset the font family, one can use this: + +#+begin_src emacs-lisp +(set-face-attribute 'italic nil :family 'unspecified) +#+end_src + +To ensure that the effects persist after switching between the Modus +themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user needs to +write their configurations to a function and hook it up to the +~modus-themes-after-load-theme-hook~. This is necessary because the +themes set the default styles of faces (otherwise changing themes would +not be possible). + +[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]. + +This is a minimal setup to preserve font configurations across theme +load phases. For a more permanent setup, it is better to employ the +~custom-set-faces~ function: ~set-face-attribute~ works just fine, though it +is more convenient for quick previews or for smaller scale operations +(~custom-set-faces~ follows the format used in the source code of the +themes). + +#+begin_src emacs-lisp +;; our generic function +(defun my-modes-themes-bold-italic-faces () + (set-face-attribute 'default nil :family "Source Code Pro" :height 110) + (set-face-attribute 'bold nil :weight 'semibold)) + +;; or use this if you configure a lot of face and attributes and +;; especially if you plan to use `modus-themes-with-colors', as shown +;; elsewhere in the manual +(defun my-modes-themes-bold-italic-faces () + (custom-set-faces + '(default ((t :family "Source Code Pro" :height 110))) + '(bold ((t :weight semibold))))) + +;; and here is the hook +(add-hook 'modus-themes-after-load-theme-hook #'my-modes-themes-bold-italic-faces) +#+end_src + ** Custom Org user faces (DIY) :properties: :custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad @@ -2263,7 +2569,8 @@ have something like this: You could then use a variant of the following to inherit from a face that uses the styles you want and also to preserve the properties -applied by the ~org-todo~ face: +applied by the ~org-todo~ face (in case there is a difference between the +two): #+begin_src emacs-lisp (setq org-todo-keyword-faces @@ -2286,9 +2593,14 @@ If you want back the defaults, try specifying just the ~org-todo~ face: #+end_src When you inherit from multiple faces, you need to quote the list as -shown further above. The order is important: the last item is applied -over the previous ones. If you do not want to blend multiple faces, you -do not need a quoted list. A pattern of =keyword . face= will suffice. +shown further above. The order is significant: the first entry is +applied on top of the second, overriding any properties that are +explicitly set for both of them: any property that is not specified is +not overridden, so, for example, if ~org-todo~ has a background and a +foreground, while ~font-lock-type-face~ only has a foreground, the merged +face will include the background of the former and the foreground of the +latter. If you do not want to blend multiple faces, you do not need a +quoted list. A pattern of =keyword . face= will suffice. Both approaches can be used simultaneously, as illustrated in this configuration of the priority cookies: @@ -2470,7 +2782,7 @@ the case for the time being. We must thus employ the face remapping technique that is documented elsewhere in this document to change the buffer-local value of the ~default~ face. -[[#h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f][Remap face with local value (DIY)]]. +[[#h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f][Remap face with local value]]. To remap the buffer's backdrop, we start with a function like this one: @@ -2628,6 +2940,7 @@ have lots of extensions, so the "full support" may not be 100% true… + counsel-org-capture-string + cov + cperl-mode ++ css-mode + csv-mode + ctrlf + custom (what you get with {{{kbd(M-x customize)}}}) @@ -2708,6 +3021,7 @@ have lots of extensions, so the "full support" may not be 100% true… + git-timemachine + git-walktree + gnus ++ gotest + golden-ratio-scroll-screen + helm* + helm-ls-git @@ -2751,6 +3065,7 @@ have lots of extensions, so the "full support" may not be 100% true… + jupyter + kaocha-runner + keycast ++ ledger-mode + line numbers (~display-line-numbers-mode~ and global variant) + lsp-mode + lsp-ui @@ -2814,6 +3129,7 @@ have lots of extensions, so the "full support" may not be 100% true… + prism ([[#h:a94272e0-99da-4149-9e80-11a7e67a2cf2][Note for prism.el]]) + proced + prodigy ++ pulse + quick-peek + racket-mode + rainbow-blocks @@ -2929,6 +3245,93 @@ supported by the themes. This section covers information that may be of interest to users of individual packages. +** Note on avy hints +:properties: +:custom_id: h:2fdce705-6de7-44e6-ab7f-18f59af99e01 +:end: + +Hints can appear everywhere, in wildly varying contexts, hence, their +appearance, by necessity, is a compromise. However, there are various +options for making them stand out. First is dimming the surroundings: + +#+begin_src emacs-lisp +(setq avy-background t) +#+end_src + +Dimming works well when you find it difficult to spot hints, any hint. +Second is limiting the number of faces used by hints: + +#+begin_src emacs-lisp +(setq avy-lead-faces + '(avy-lead-face + avy-lead-face-1 + avy-lead-face-1 + avy-lead-face-1 + avy-lead-face-1)) +#+end_src + +Limiting the number of faces works well with longer hints when you find +it difficult to identify individual hints, especially with hints +touching each other. The first character of the hint will have an +intense color, the remaining ones the same neutral color. + +Third is preferring commands that produce fewer candidates. Fewer hints +is less noise: ~avy-goto-char-timer~ is an excellent alternative to +~avy-goto-char~. + +** Note on calendar.el weekday and weekend colors +:properties: +:custom_id: h:b2db46fb-32f4-44fd-8e11-d2b261cf51ae +:end: + +By default, the {{{kbd(M-x calendar)}}} interface differentiates weekdays from +weekends by applying a gray color to the former and a faint red to the +latter. The idea for this approach is that the weekend should serve as +a subtle warning that no work is supposed to be done on that day, per +the design of traditional calendars. + +Users who prefer all days to look the same can configure the variable +~calendar-weekend-days~ to either use gray of weekdays or the faint red of +weekends uniformly. + +#+begin_src emacs-lisp +;; All are treated like weekdays (gray color) +(setq calendar-weekend-days nil) + +;; All are treated like weekends (red-faint color) +(setq calendar-weekend-days (number-sequence 0 6)) + +;; The default marks the Saturday and Sunday as the weekend +(setq calendar-weekend-days '(0 6)) +#+end_src + +For changes to take effect, the Calendar buffer needs to be generated +anew. + +** Note on underlines in compilation buffers +:properties: +:custom_id: h:420f5a33-c7a9-4112-9b04-eaf2cbad96bd +:end: + +Various buffers that produce compilation results or run tests on code +apply an underline to the file names they reference or to relevant +messages. Users may consider this unnecessary or excessive. + +To outright disable the effect, use this: + +#+begin_src emacs-lisp +(setq compilation-message-face nil) +#+end_src + +If some element of differentiation is still desired, a good option is to +render the affected text using the ~italic~ face: + +#+begin_src emacs-lisp +(setq compilation-message-face 'italic) +#+end_src + +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. + ** Note on inline Latex in Org buffers :properties: :custom_id: h:dd8478da-f56a-45cd-b199-b836c85c3c5a @@ -3566,9 +3969,9 @@ In general, an additional source of light other than that of the monitor can help reduce eye strain: the eyes are more relaxed when they do not have to focus on one point to gather light. -The monitor's display settings must be accounted for. Gamma ray values, -in particular, need to be calibrated to neither amplify nor distort the -perception of black. Same principle for sharpness, brightness, and +The monitor's display settings must be accounted for. Gamma values, in +particular, need to be calibrated to neither amplify nor distort the +perception of black. Same principle for sharpness, brightness, and contrast as determined by the hardware, which all have an effect on how text is read on the screen. @@ -3716,8 +4119,9 @@ The Modus themes are a collective effort. Every bit of work matters. + Contributions to code or documentation :: Anders Johansson, Basil L.{{{space()}}} Contovounesios, Carlo Zancanaro, Eli Zaretskii, Fritz Grabo, Kostadin Ninev, Madhavan Krishnan, Markus Beppler, Matthew Stevenson, - Mauro Aranda, Nicolas De Jaeghere, Rudolf Adamkovič, Shreyas Ragavan, - Stefan Kangas, Vincent Murphy, Xinglu Chen. + Mauro Aranda, Nicolas De Jaeghere, Philip Kaludercic, Rudolf + Adamkovič, Shreyas Ragavan, Stefan Kangas, Vincent Murphy, Xinglu + Chen. + Ideas and user feedback :: Aaron Jensen, Adam Spiers, Adrian Manea, Alex Griffin, Alex Peitsinis, Alexey Shmalko, Alok Singh, Anders @@ -3725,19 +4129,20 @@ The Modus themes are a collective effort. Every bit of work matters. Contovounesios, Burgess Chang, Christian Tietze, Christopher Dimech, Damien Cassou, Daniel Mendler, Dario Gjorgjevski, David Edmondson, Davor Rotim, Divan Santana, Emanuele Michele Alberto Monterosso, - Farasha Euker, Gerry Agbobada, Gianluca Recchia, Gustavo Barros, - Hörmetjan Yiltiz, Ilja Kocken, Iris Garcia, Jeremy Friesen, John - Haman, Joshua O'Connor, Kevin Fleming, Kévin Le Gouguec, Kostadin - Ninev, Len Trigg, Manuel Uberti, Mark Burton, Markus Beppler, Mauro - Aranda, Michael Goldenberg, Morgan Smith, Murilo Pereira, Nicky van - Foreest, Nicolas De Jaeghere, Paul Poloskov, Pete Kazmier, Peter Wu, - Philip K., Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, Rudolf - Adamkovič, Sam Kleinman, Shreyas Ragavan, Simon Pugnet, Tassilo Horn, - Thibaut Verron, Trey Merkley, Togan Muftuoglu, Toon Claes, Uri Sharf, - Utkarsh Singh, Vincent Foley. As well as users: Ben, CsBigDataHub1, - Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, TheBlob42, - Trey, bepolymathe, doolio, fleimgruber, iSeeU, jixiuf, okamsn, - pRot0ta1p. + Farasha Euker, Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia, + Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Iris Garcia, Jeremy + Friesen, Jerry Zhang, John Haman, Joshua O'Connor, Kevin Fleming, + Kévin Le Gouguec, Kostadin Ninev, Len Trigg, Manuel Uberti, Mark + Burton, Markus Beppler, Mauro Aranda, Michael Goldenberg, Morgan + Smith, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Paul + Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic, + Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, Rudolf Adamkovič, + Sam Kleinman, Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thibaut + Verron, Thomas Heartman, Trey Merkley, Togan Muftuoglu, Toon Claes, + Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben, + CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, + Nick, TheBlob42, Trey, bepolymathe, doolio, fleimgruber, iSeeU, + jixiuf, okamsn, pRot0ta1p. + Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core Emacs), @@ -3747,9 +4152,9 @@ The Modus themes are a collective effort. Every bit of work matters. + Inspiration for certain features :: Bozhidar Batsov (zenburn-theme), Fabrice Niessen (leuven-theme). -Special thanks, in no particular order, to Manuel Uberti and Omar -Antolín Camarena for their long time contributions and insightful -commentary. +Special thanks, in no particular order, to Manuel Uberti, Gustavo +Barros, and Omar Antolín Camarena for their long time contributions and +insightful commentary. * Meta :properties: diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index cd73681599..a946d747e8 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -4,7 +4,7 @@ ;; Author: Protesilaos Stavrou ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 1.4.0 +;; Version: 1.5.0 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: faces, theme, accessibility diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index c70c560b9e..b9fe4a3272 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -4,8 +4,8 @@ ;; Author: Protesilaos Stavrou ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 1.4.0 -;; Last-Modified: <2021-05-25 12:25:39 +0300> +;; Version: 1.5.0 +;; Last-Modified: <2021-07-15 13:21:55 +0300> ;; Package-Requires: ((emacs "26.1")) ;; Keywords: faces, theme, accessibility @@ -33,10 +33,10 @@ ;; official Info manual for further documentation (distributed with the ;; themes, or available at: ). ;; -;; The themes share the following customization variables, all of which -;; are disabled by default (nil): +;; The themes share the following customization variables: ;; -;; modus-themes-slanted-constructs (boolean) +;; modus-themes-inhibit-reload (boolean) +;; modus-themes-italic-constructs (boolean) ;; modus-themes-bold-constructs (boolean) ;; modus-themes-variable-pitch-headings (boolean) ;; modus-themes-variable-pitch-ui (boolean) @@ -47,8 +47,8 @@ ;; modus-themes-headings (alist) ;; modus-themes-fringes (choice) ;; modus-themes-lang-checkers (choice) +;; modus-themes-org-agenda (alist) ;; modus-themes-org-blocks (choice) -;; modus-themes-org-habit (choice) ;; modus-themes-prompts (choice) ;; modus-themes-mode-line (choice) ;; modus-themes-diffs (choice) @@ -63,11 +63,11 @@ ;; The default scale for headings is as follows (it can be customized as ;; well---remember, no scaling takes place by default): ;; -;; modus-themes-scale-1 1.05 -;; modus-themes-scale-2 1.1 -;; modus-themes-scale-3 1.15 -;; modus-themes-scale-4 1.2 -;; modus-themes-scale-5 1.3 +;; modus-themes-scale-1 1.05 +;; modus-themes-scale-2 1.1 +;; modus-themes-scale-3 1.15 +;; modus-themes-scale-4 1.2 +;; modus-themes-scale-title 1.3 ;; ;; There also exist two unique customization variables for overriding ;; color palette values. The specifics are documented in the manual. @@ -122,6 +122,7 @@ ;; counsel-org-capture-string ;; cov ;; cperl-mode +;; css-mode ;; csv-mode ;; ctrlf ;; custom (M-x customize) @@ -203,6 +204,7 @@ ;; git-timemachine ;; git-walktree ;; gnus +;; gotest ;; golden-ratio-scroll-screen ;; helm ;; helm-ls-git @@ -245,6 +247,7 @@ ;; jupyter ;; kaocha-runner ;; keycast +;; ledger-mode ;; line numbers (`display-line-numbers-mode' and global variant) ;; lsp-mode ;; lsp-ui @@ -307,6 +310,7 @@ ;; prism (see "Note for prism.el" in the manual) ;; proced ;; prodigy +;; pulse ;; quick-peek ;; racket-mode ;; rainbow-blocks @@ -395,20 +399,6 @@ ;; - modus-operandi-theme.el (Light theme) ;; - modus-vivendi-theme.el (Dark theme) -;;; News: -;; -;; Users updating from older versions to >= 1.0.0, are advised to read -;; the announcement on the emacs-devel mailing list: -;; . -;; -;; The web page of the change log is also available: -;; . -;; -;; An Info manual should be distributed with the Modus themes. -;; Evaluate this form to access it directly: -;; -;; (info "(modus-themes) Top") - ;;; Code: @@ -430,6 +420,13 @@ cover the blue-cyan-magenta side of the spectrum." :prefix "modus-themes-" :tag "Modus Themes") +(defgroup modus-themes-faces () + "Faces defined my `modus-operandi' and `modus-vivendi'." + :group 'modus-themes + :link '(info-link "(modus-themes) Top") + :prefix "modus-themes-" + :tag "Modus Themes Faces") + ;;; Variables for each theme variant ;;;; Modus Operandi @@ -614,6 +611,7 @@ cover the blue-cyan-magenta side of the spectrum." (bg-paren-expression . "#dff0ff") (bg-region . "#bcbcbc") (bg-region-accent . "#afafef") + (bg-region-accent-subtle . "#efdfff") (bg-tab-bar . "#d5d5d5") (bg-tab-active . "#f6f6f6") @@ -710,9 +708,9 @@ symbol and the latter as a string.") (green-faint . "#78bf78") (green-alt-faint . "#99b56f") (green-alt-other-faint . "#88bf99") - (yellow . "#e0cc00") - (yellow-alt . "#c4d030") - (yellow-alt-other . "#e3c55f") + (yellow . "#d0bc00") + (yellow-alt . "#c0c530") + (yellow-alt-other . "#d3b55f") (yellow-faint . "#d2b580") (yellow-alt-faint . "#cabf77") (yellow-alt-other-faint . "#d0ba95") @@ -847,7 +845,7 @@ symbol and the latter as a string.") ;; ;; all pairs are combinable with themselves (bg-hl-line . "#151823") - (bg-hl-line-intense . "#2f2f2f") + (bg-hl-line-intense . "#292929") (bg-hl-line-intense-accent . "#00353f") (bg-hl-alt . "#181732") (bg-hl-alt-intense . "#282e46") @@ -856,6 +854,7 @@ symbol and the latter as a string.") (bg-paren-expression . "#221044") (bg-region . "#3c3c3c") (bg-region-accent . "#4f3d88") + (bg-region-accent-subtle . "#240f55") (bg-tab-bar . "#2c2c2c") (bg-tab-active . "#0e0e0e") @@ -928,212 +927,244 @@ symbol and the latter as a string.") This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-subtle-green nil "Subtle green background combined with a dimmed foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-subtle-yellow nil "Subtle yellow background combined with a dimmed foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-subtle-blue nil "Subtle blue background combined with a dimmed foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-subtle-magenta nil "Subtle magenta background combined with a dimmed foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-subtle-cyan nil "Subtle cyan background combined with a dimmed foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-subtle-neutral nil "Subtle gray background combined with a dimmed foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-intense-red nil "Intense red background combined with the main foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-intense-green nil "Intense green background combined with the main foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-intense-yellow nil "Intense yellow background combined with the main foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-intense-blue nil "Intense blue background combined with the main foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-intense-magenta nil "Intense magenta background combined with the main foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-intense-cyan nil "Intense cyan background combined with the main foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-intense-neutral nil "Intense gray background combined with the main foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-refine-red nil "Combination of accented red background and foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-refine-green nil "Combination of accented green background and foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-refine-yellow nil "Combination of accented yellow background and foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-refine-blue nil "Combination of accented blue background and foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-refine-magenta nil "Combination of accented magenta background and foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-refine-cyan nil "Combination of accented cyan background and foreground. This is used for general purpose highlighting, mostly in buffers or for completion interfaces. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-active-red nil "A red background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-active-green nil "A green background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-active-yellow nil "A yellow background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-active-blue nil "A blue background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-active-magenta nil "A magenta background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-active-cyan nil "A cyan background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-fringe-red nil "A red background meant for use on the fringe or similar. This is combined with the main foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-fringe-green nil "A green background meant for use on the fringe or similar. This is combined with the main foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-fringe-yellow nil "A yellow background meant for use on the fringe or similar. This is combined with the main foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-fringe-blue nil "A blue background meant for use on the fringe or similar. This is combined with the main foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-fringe-magenta nil "A magenta background meant for use on the fringe or similar. This is combined with the main foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-fringe-cyan nil "A cyan background meant for use on the fringe or similar. This is combined with the main foreground value. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-nuanced-red nil "A nuanced red background. @@ -1142,7 +1173,8 @@ meant to serve as the backdrop for elements such as Org blocks, headings, and any other surface that needs to retain the colors on display. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-nuanced-green nil "A nuanced green background. @@ -1151,7 +1183,8 @@ meant to serve as the backdrop for elements such as Org blocks, headings, and any other surface that needs to retain the colors on display. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-nuanced-yellow nil "A nuanced yellow background. @@ -1160,7 +1193,8 @@ meant to serve as the backdrop for elements such as Org blocks, headings, and any other surface that needs to retain the colors on display. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-nuanced-blue nil "A nuanced blue background. @@ -1169,7 +1203,8 @@ meant to serve as the backdrop for elements such as Org blocks, headings, and any other surface that needs to retain the colors on display. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-nuanced-magenta nil "A nuanced magenta background. @@ -1178,7 +1213,8 @@ meant to serve as the backdrop for elements such as Org blocks, headings, and any other surface that needs to retain the colors on display. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-nuanced-cyan nil "A nuanced cyan background. @@ -1187,7 +1223,8 @@ meant to serve as the backdrop for elements such as Org blocks, headings, and any other surface that needs to retain the colors on display. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-special-cold nil "Combines the 'special cold' background and foreground values. @@ -1195,7 +1232,8 @@ This is intended for cases when a neutral gray background is not suitable and where a combination of more saturated colors would not be appropriate. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-special-mild nil "Combines the 'special mild' background and foreground values. @@ -1203,7 +1241,8 @@ This is intended for cases when a neutral gray background is not suitable and where a combination of more saturated colors would not be appropriate. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-special-warm nil "Combines the 'special warm' background and foreground values. @@ -1211,7 +1250,8 @@ This is intended for cases when a neutral gray background is not suitable and where a combination of more saturated colors would not be appropriate. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-special-calm nil "Combines the 'special calm' background and foreground values. @@ -1219,188 +1259,223 @@ This is intended for cases when a neutral gray background is not suitable and where a combination of more saturated colors would not be appropriate. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-added nil "Combines green colors for the 'added' state in diffs. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-changed nil "Combines yellow colors for the 'changed' state in diffs. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-removed nil "Combines red colors for the 'removed' state in diffs. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-refine-added nil "Combines green colors for word-wise 'added' state in diffs. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-refine-changed nil "Combines yellow colors for word-wise 'changed' state in diffs. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-refine-removed nil "Combines red colors for word-wise 'removed' state in diffs. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-focus-added nil "Combines green colors for the focused 'added' state in diffs. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-focus-changed nil "Combines yellow colors for the focused 'changed' state in. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-focus-removed nil "Combines red colors for the focused 'removed' state in diffs. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-diff-heading nil "Combines blue colors for the diff hunk heading. The applied colors are contingent on the value assigned to `modus-themes-diffs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-pseudo-header nil "Generic style for some elements that function like headings. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-mark-alt nil "Combines yellow colors for marking special lines. This is intended for use in modes such as Dired, Ibuffer, Proced. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-mark-del nil "Combines red colors for marking deletable lines. This is intended for use in modes such as Dired, Ibuffer, Proced. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-mark-sel nil "Combines green colors for marking lines. This is intended for use in modes such as Dired, Ibuffer, Proced. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-mark-symbol nil "Applies a blue color and other styles for mark indicators. This is intended for use in modes such as Dired, Ibuffer, Proced. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-heading-1 nil "General purpose face for use in headings level 1. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-heading-2 nil "General purpose face for use in headings level 2. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-heading-3 nil "General purpose face for use in headings level 3. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-heading-4 nil "General purpose face for use in headings level 4. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-heading-5 nil "General purpose face for use in headings level 5. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-heading-6 nil "General purpose face for use in headings level 6. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-heading-7 nil "General purpose face for use in headings level 7. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-heading-8 nil "General purpose face for use in headings level 8. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-hl-line nil "General purpose face for the current line. The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-hl-line' variable. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-bold nil "Generic face for applying a conditional bold weight. This behaves in accordance with `modus-themes-bold-constructs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-slant nil "Generic face for applying a conditional slant (italics). -This behaves in accordance with `modus-themes-slanted-constructs'. +This behaves in accordance with `modus-themes-italic-constructs'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-variable-pitch nil "Generic face for applying a conditional `variable-pitch'. This behaves in accordance with `modus-themes-no-mixed-fonts', -`modus-themes-variable-pitch-headings' for all heading levels, and -`modus-themes-variable-pitch-ui'. +`modus-themes-variable-pitch-headings' for all heading levels, +and `modus-themes-variable-pitch-ui'. + +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) -The actual styling of the face is done by `modus-themes-faces'.") +(defface modus-themes-fixed-pitch nil + "Generic face for applying a conditional `fixed-pitch'. +This behaves in accordance with `modus-themes-no-mixed-fonts'. + +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-red-0 nil "Special subdued red face for use in graphs. @@ -1408,7 +1483,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-red-1 nil "Special prominent red face for use in graphs. @@ -1416,7 +1492,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-green-0 nil "Special subdued green face for use in graphs. @@ -1424,7 +1501,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-green-1 nil "Special prominent green face for use in graphs. @@ -1432,7 +1510,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-yellow-0 nil "Special subdued yellow face for use in graphs. @@ -1440,7 +1519,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-yellow-1 nil "Special prominent yellow face for use in graphs. @@ -1448,7 +1528,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-blue-0 nil "Special subdued blue face for use in graphs. @@ -1456,7 +1537,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-blue-1 nil "Special prominent blue face for use in graphs. @@ -1464,7 +1546,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-magenta-0 nil "Special subdued magenta face for use in graphs. @@ -1472,7 +1555,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-magenta-1 nil "Special prominent magenta face for use in graphs. @@ -1480,7 +1564,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-cyan-0 nil "Special subdued cyan face for use in graphs. @@ -1488,7 +1573,8 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-graph-cyan-1 nil "Special prominent cyan face for use in graphs. @@ -1496,28 +1582,32 @@ This is intended to be applied in contexts such as the Org agenda habit graph where faithfulness to the semantics of a color value is of paramount importance. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-lang-note nil "Generic face for linter or spell checker notes. The exact attributes and color combinations are controlled by `modus-themes-lang-checkers'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-lang-warning nil "Generic face for linter or spell checker warnings. The exact attributes and color combinations are controlled by `modus-themes-lang-checkers'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-lang-error nil "Generic face for linter or spell checker errors. The exact attributes and color combinations are controlled by `modus-themes-lang-checkers'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-reset-soft nil "Generic face to set most face properties to nil. @@ -1527,7 +1617,8 @@ properties from their context (e.g. an overlay over an underlined text should not be underlined as well) yet still blend in. Also see `modus-themes-reset-hard'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-reset-hard nil "Generic face to set all face properties to nil. @@ -1537,28 +1628,68 @@ properties from their context (e.g. an overlay over an underlined text should not be underlined as well) and not blend in. Also see `modus-themes-reset-soft'. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-key-binding nil "Generic face for key bindings. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-search-success nil "Generic face for successful search. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-search-success-modeline nil "Generic mode line indicator for successful search. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) (defface modus-themes-search-success-lazy nil "Generic face for successful, lazily highlighted search. -The actual styling of the face is done by `modus-themes-faces'.") +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) + +(defface modus-themes-prompt nil + "Generic face for command prompts. +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-theme-faces) ;;; Customization variables +(defcustom modus-themes-inhibit-reload t + "Control theme reload when setting options with Customize. + +By default, customizing a theme-related user option through the +Custom interfaces or with `customize-set-variable' will not +reload the currently active Modus theme. + +Enable this behaviour by setting this variable to nil." + :group 'modus-themes + :package-version '(modus-themes . "1.5.0") + :version "28.1" + :type 'boolean + :link '(info-link "(modus-themes) Custom reload theme")) + +(defun modus-themes--set-option (sym val) + "Custom setter for theme related user options. +Will set SYM to VAL, and reload the current theme, unless +`modus-themes-inhibit-reload' is non-nil." + (set-default sym val) + (unless (or modus-themes-inhibit-reload + ;; Check if a theme is being loaded, in which case we + ;; don't want to reload a theme if the setter is + ;; invoked. `custom--inhibit-theme-enable' is set to nil + ;; by `enable-theme'. + (null (bound-and-true-p custom--inhibit-theme-enable))) + (let ((modus-themes-inhibit-reload t)) + (pcase (modus-themes--current-theme) + ('modus-operandi (modus-themes-load-operandi)) + ('modus-vivendi (modus-themes-load-vivendi)))))) + (defcustom modus-themes-operandi-color-overrides nil "Override colors in the Modus Operandi palette. @@ -1567,6 +1698,8 @@ For form, see `modus-themes-operandi-colors'." :package-version '(modus-themes . "1.1.0") :version "28.1" :type '(alist :key-type symbol :value-type color) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Override colors (DIY)")) (defcustom modus-themes-vivendi-color-overrides nil @@ -1577,6 +1710,8 @@ For form, see `modus-themes-vivendi-colors'." :package-version '(modus-themes . "1.1.0") :version "28.1" :type '(alist :key-type symbol :value-type color) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Override colors (DIY)")) ;; The byte compiler complains when a defcustom isn't a top level form @@ -1595,14 +1730,33 @@ For form, see `modus-themes-vivendi-colors'." :package-version '(modus-themes . "1.0.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Slanted constructs")) +(define-obsolete-variable-alias + 'modus-themes-slanted-constructs + 'modus-themes-italic-constructs + "1.5.0") + +(defcustom modus-themes-italic-constructs nil + "Use italic font forms in more code constructs." + :group 'modus-themes + :package-version '(modus-themes . "1.5.0") + :version "28.1" + :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Italic constructs")) + (defcustom modus-themes-bold-constructs nil "Use bold text in more code constructs." :group 'modus-themes :package-version '(modus-themes . "1.0.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Bold constructs")) (defcustom modus-themes-variable-pitch-headings nil @@ -1611,6 +1765,8 @@ For form, see `modus-themes-vivendi-colors'." :package-version '(modus-themes . "1.0.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Headings' typeface")) (defcustom modus-themes-variable-pitch-ui nil @@ -1620,6 +1776,8 @@ This includes the mode line, header line, tab bar, and tab line." :package-version '(modus-themes . "1.1.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) UI typeface")) (defcustom modus-themes-no-mixed-fonts nil @@ -1637,110 +1795,97 @@ mixing fonts." :package-version '(modus-themes . "1.0.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) No mixed fonts")) (defconst modus-themes--headings-choice - '(choice - (const :format "[%v] %t\n" :tag "Fairly desaturated foreground with bold weight (default)" nil) - (const :format "[%v] %t\n" :tag "Same as the default (backward-compatible)" t) - (const :format "[%v] %t\n" :tag "Like the default without bold weight" no-bold) - (const :format "[%v] %t\n" :tag "Like the default plus overline" line) - (const :format "[%v] %t\n" :tag "Like `line' without bold weight" line-no-bold) - (const :format "[%v] %t\n" :tag "Like the default but with more colorful foreground" rainbow) - (const :format "[%v] %t\n" :tag "Like `rainbow' plus overline" rainbow-line) - (const :format "[%v] %t\n" :tag "Like `rainbow' without bold weight" rainbow-no-bold) - (const :format "[%v] %t\n" :tag "Like `rainbow-line' without bold weight" rainbow-line-no-bold) - (const :format "[%v] %t\n" :tag "Like the default plus subtle background" highlight) - (const :format "[%v] %t\n" :tag "Like `highlight' without bold weight" highlight-no-bold) - (const :format "[%v] %t\n" :tag "Like `highlight' with more colorful foreground" rainbow-highlight) - (const :format "[%v] %t\n" :tag "Like `rainbow-highlight' without bold weight" rainbow-highlight-no-bold) - (const :format "[%v] %t\n" :tag "Like `highlight' plus overline" section) - (const :format "[%v] %t\n" :tag "Like `section' without bold weight" section-no-bold) - (const :format "[%v] %t\n" :tag "Like `section' with more colorful foreground" rainbow-section) - (const :format "[%v] %t\n" :tag "Like `rainbow-section' without bold weight" rainbow-section-no-bold) - (const :format "[%v] %t\n" :tag "Do not use any distinct foreground color; just bold weight" no-color) - (const :format "[%v] %t\n" :tag "Like `no-bold' but without the distinct foreground color" no-color-no-bold)) + '(set :tag "Properties" :greedy t + (const :tag "Background color" background) + (const :tag "Overline" overline) + (const :tag "No bold weight" no-bold) + (choice :tag "Colors" + (const :tag "Subtle colors" nil) + (const :tag "Rainbow colors" rainbow) + (const :tag "Monochrome" monochrome))) "Refer to the doc string of `modus-themes-headings'. This is a helper variable intended for internal use.") (defcustom modus-themes-headings nil - "Alist of styles for headings, with optional value per level. - -To control faces per level from 1-8, use something like this: + "Heading styles with optional list of values for levels 1-8. - (setq modus-themes-headings - '((1 . highlight) - (2 . line) - (t . rainbow-line-no-bold))) +This is an alist that accepts a (key . list-of-values) +combination. The key is either a number, representing the +heading's level or t, which pertains to the fallback style. The +list of values covers symbols that refer to properties, as +described below. Here is a sample, followed by a presentation of +all available properties: -To set a uniform value for all heading levels, use this pattern: + (setq modus-themes-headings + '((1 . (background overline)) + (2 . (overline rainbow)) + (t . (monochrome)))) - (setq modus-themes-headings - '((t . rainbow-line-no-bold))) +By default (a nil value for this variable), all headings have a +bold typographic weight and use a desaturated text color. -The default value uses a fairly desaturated foreground color in -combination with a bold typographic weight. To specify this -style for a given level N (assuming you wish to have another -fallback option), just specify the value nil like this: +A `rainbow' property makes the text color more saturated. - (setq modus-themes-headings - '((1 . nil) - (2 . line) - (3) ; same as nil - (t . rainbow-line-no-bold))) +An `overline' property draws a line above the area of the +heading. -A description of all other possible values: +A `background' property adds a subtle tinted color to the +background of the heading. -+ `no-bold' retains the default text color while removing the - typographic weight. +A `no-bold' property removes the bold weight from the heading's +text. -+ `line' is the same as the default plus an overline over the - heading. +A `monochrome' property makes all headings the same base color, +which is that of the default for the active theme (black/white). +When `background' is also set, `monochrome' changes its color to +gray. If both `monochrome' and `rainbow' are set, the former +takes precedence. -+ `line-no-bold' is the same as `line' without bold weight. +Combinations of any of those properties are expressed as a list, +like in these examples: -+ `rainbow' uses a more colorful foreground in combination with - bold weight. + (no-bold) + (rainbow background) + (overline monochrome no-bold) -+ `rainbow-line' is the same as `rainbow' plus an overline. +The order in which the properties are set is not significant. -+ `rainbow-line-no-bold' is the same as `rainbow-line' without - the bold weight. +In user configuration files the form may look like this: -+ `highlight' retains the default style of a fairly desaturated - foreground combined with a bold weight and add to it a subtle - accented background. + (setq modus-themes-headings + '((1 . (background overline rainbow)) + (2 . (background overline)) + (t . (overline no-bold)))) -+ `highlight-no-bold' is the same as `highlight' without a bold - weight. +When defining the styles per heading level, it is possible to +pass a non-nil value (t) instead of a list of properties. This +will retain the original aesthetic for that level. For example: -+ `rainbow-highlight' is the same as `highlight' but with a more - colorful foreground. + (setq modus-themes-headings + '((1 . t) ; keep the default style + (2 . (background overline)) + (t . (rainbow)))) ; style for all other headings -+ `rainbow-highlight-no-bold' is the same as `rainbow-highlight' - without a bold weight. + (setq modus-themes-headings + '((1 . (background overline)) + (2 . (rainbow no-bold)) + (t . t))) ; default style for all other levels -+ `section' retains the default looks and adds to them both an - overline and a slightly accented background. It is, in effect, - a combination of the `line' and `highlight' values. +For Org users, the extent of the heading depends on the variable +`org-fontify-whole-heading-line'. This affects the `overline' +and `background' properties. Depending on the version of Org, +there may be others, such as `org-fontify-done-headline'. -+ `section-no-bold' is the same as `section' without a bold - weight. - -+ `rainbow-section' is the same as `section' but with a more - colorful foreground. - -+ `rainbow-section-no-bold' is the same as `rainbow-section' - without a bold weight. - -+ `no-color' does not apply any color to the heading, meaning - that it uses the foreground of the `default' face. It still - renders the text with a bold typographic weight. - -+ `no-color-no-bold' is like `no-color' but without the bold - weight." +Also read `modus-themes-scale-headings' to change the height of +headings and `modus-themes-variable-pitch-headings' to make them +use a proportionately spaced font." :group 'modus-themes - :package-version '(modus-themes . "1.3.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" :type `(alist :options ,(mapcar (lambda (el) @@ -1748,16 +1893,166 @@ A description of all other possible values: '(1 2 3 4 5 6 7 8 t)) :key-type symbol :value-type ,modus-themes--headings-choice) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Heading styles")) +(defcustom modus-themes-org-agenda nil + "Control the style of individual Org agenda constructs. + +This is an alist that accepts a (key . value) combination. Here +is a sample, followed by a description of all possible +combinations: + + (setq modus-themes-org-agenda + '((header-block . (variable-pitch scale-title)) + (header-date . (grayscale workaholic bold-today)) + (scheduled . uniform) + (habit . traffic-light))) + +A `header-block' key applies to elements that concern the +headings which demarcate blocks in the structure of the agenda. +By default (a nil value) those are rendered in a bold typographic +weight, plus a height that is slightly taller than the default +font size. Acceptable values come in the form of a list that can +include either or both of those properties: + +- `variable-pitch' to use a proportionately spaced typeface; +- `scale-title' to increase height to `modus-themes-scale-title' + OR `no-scale' to set the font to the same height as the rest of + the buffer. + +In case both `scale-title' and `no-scale' are in the list, the +latter takes precedence. + +Example usage: + + (header-block . nil) + (header-block . (scale-title)) + (header-block . (no-scale)) + (header-block . (variable-pitch scale-title)) + +A `header-date' key covers date headings. Dates use only a +foreground color by default (a nil value), with weekdays and +weekends having a slight difference in hueness. The current date +has an added gray background. This key accepts a list of values +that can include any of the following properties: + +- `grayscale' to make weekdays use the main foreground color and + weekends a more subtle gray; +- `workaholic' to make weekdays and weekends look the same in + terms of color; +- `bold-today' to apply a bold typographic weight to the current + date; +- `bold-all' to render all date headings in a bold weight. + +For example: + + (header-date . nil) + (header-date . (workaholic)) + (header-date . (grayscale bold-all)) + (header-date . (grayscale workaholic)) + (header-date . (grayscale workaholic bold-today)) + +A `scheduled' key applies to tasks with a scheduled date. By +default (a nil value), these use varying shades of yellow to +denote (i) a past or current date and (ii) a future date. Valid +values are symbols: + +- nil (default); +- `uniform' to make all scheduled dates the same color; +- `rainbow' to use contrasting colors for past, present, future + scheduled dates. + +For example: + + (scheduled . nil) + (scheduled . uniform) + (scheduled . rainbow) + +A `habit' key applies to the `org-habit' graph. All possible +value are passed as a symbol. Those are: + +- The default (nil) is meant to conform with the original + aesthetic of `org-habit'. It employs all four color codes that + correspond to the org-habit states---clear, ready, alert, and + overdue---while distinguishing between their present and future + variants. This results in a total of eight colors in use: red, + yellow, green, blue, in tinted and shaded versions. They cover + the full set of information provided by the `org-habit' + consistency graph. +- `simplified' is like the default except that it removes the + dichotomy between current and future variants by applying + uniform color-coded values. It applies a total of four colors: + red, yellow, green, blue. They produce a simplified + consistency graph that is more legible (or less \"busy\") than + the default. The intent is to shift focus towards the + distinction between the four states of a habit task, rather + than each state's present/future outlook. +- `traffic-light' further reduces the available colors to red, + yellow, and green. As in `simplified', present and future + variants appear uniformly, but differently from it, the 'clear' + state is rendered in a green hue, instead of the original blue. + This is meant to capture the use-case where a habit task being + \"too early\" is less important than it being \"too late\". + The difference between ready and clear states is attenuated by + painting both of them using shades of green. This option thus + highlights the alert and overdue states. +- `traffic-light-deuteranopia' is like the `traffic-light' except + its three colors are red, yellow, and blue to be suitable for + users with red-green color deficiency (deuteranopia). + +For example: + + (habit . nil) + (habit . simplified) + (habit . traffic-light)" + :group 'modus-themes + :package-version '(modus-themes . "1.5.0") + :version "28.1" + :type '(set + (cons :tag "Block header" + (const header-block) + (set :tag "Header presentation" :greedy t + (choice :tag "Font style" + (const :tag "Use the original typeface (default)" nil) + (const :tag "Use `variable-pitch' font" variable-pitch)) + (choice :tag "Scaling" + (const :tag "Slight increase in height (default)" nil) + (const :tag "Do not scale" no-scale) + (const :tag "Scale to match `modus-themes-scale-title'" scale-title)))) + (cons :tag "Date header" :greedy t + (const header-date) + (set :tag "Header presentation" :greedy t + (const :tag "Use grayscale for date headers" grayscale) + (const :tag "Do not differentiate weekdays from weekends" workaholic) + (const :tag "Make today bold" bold-today) + (const :tag "Make all dates bold" bold-all))) + (cons :tag "Scheduled tasks" + (const scheduled) + (choice (const :tag "Yellow colors to distinguish current and future tasks (default)" nil) + (const :tag "Uniform subtle warm color for all scheduled tasks" uniform) + (const :tag "Rainbow-colored scheduled tasks" rainbow))) + (cons :tag "Habit graph" + (const habit) + (choice (const :tag "Follow the original design of `org-habit' (default)" nil) + (const :tag "Do not distinguish between present and future variants" simplified) + (const :tag "Use only red, yellow, green" traffic-light) + (const :tag "Use only red, yellow, blue" traffic-light-deuteranopia)))) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Org agenda")) + (defcustom modus-themes-scale-headings nil "Use font scaling for headings. For regular headings the scale is controlled by the variables `modus-themes-scale-1' (smallest) and its variants all the way up -to `modus-themes-scale-4' (larger). While `modus-themes-scale-5' -is reserved for special headings that must be the largest on the -scale. +to `modus-themes-scale-4' (larger). + +While `modus-themes-scale-title' is reserved for special headings +that nominally are the largest on the scale (though that is not a +requirement). A special heading is, in this context, one that does not fit into the syntax for heading levels that apply to the given mode. For @@ -1768,6 +2063,8 @@ special heading." :package-version '(modus-themes . "1.2.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Scaled headings")) (defcustom modus-themes-scale-1 1.05 @@ -1790,6 +2087,8 @@ accordance with it in cases where it changes, such as while using :package-version '(modus-themes . "1.2.0") :version "28.1" :type 'number + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Scaled heading sizes")) (defcustom modus-themes-scale-2 1.1 @@ -1812,6 +2111,8 @@ accordance with it in cases where it changes, such as while using :package-version '(modus-themes . "1.2.0") :version "28.1" :type 'number + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Scaled heading sizes")) (defcustom modus-themes-scale-3 1.15 @@ -1834,6 +2135,8 @@ accordance with it in cases where it changes, such as while using :package-version '(modus-themes . "1.2.0") :version "28.1" :type 'number + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Scaled heading sizes")) (defcustom modus-themes-scale-4 1.2 @@ -1856,6 +2159,8 @@ accordance with it in cases where it changes, such as while using :package-version '(modus-themes . "1.2.0") :version "28.1" :type 'number + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Scaled heading sizes")) (defcustom modus-themes-scale-5 1.3 @@ -1879,6 +2184,35 @@ accordance with it in cases where it changes, such as while using :package-version '(modus-themes . "1.2.0") :version "28.1" :type 'number + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Scaled heading sizes")) + +(define-obsolete-variable-alias 'modus-themes-scale-5 'modus-themes-scale-title "1.5.0") + +(defcustom modus-themes-scale-title 1.3 + "Font size slightly larger than `modus-themes-scale-4'. + +This size is only used for 'special' top level headings, such as +Org's file title heading, denoted by the #+title key word, and +the Org agenda structure headers (see `modus-themes-org-agenda'). + +The default value is a floating point that is interpreted as a +multiple of the base font size. It is recommended to use such a +value. + +However, the variable also accepts an integer, understood as an +absolute height that is 1/10 of the typeface's point size (e.g. a +value of 140 is the same as setting the font at 14 point size). +This will ignore the base font size and, thus, will not scale in +accordance with it in cases where it changes, such as while using +`text-scale-adjust'." + :group 'modus-themes + :package-version '(modus-themes . "1.5.0") + :version "28.1" + :type 'number + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Scaled heading sizes")) (defcustom modus-themes-fringes nil @@ -1895,40 +2229,62 @@ pronounced grayscale value." (const :format "[%v] %t\n" :tag "No visible fringes (default)" nil) (const :format "[%v] %t\n" :tag "Subtle grayscale background" subtle) (const :format "[%v] %t\n" :tag "Intense grayscale background" intense)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Fringes")) (defcustom modus-themes-lang-checkers nil "Control the style of spelling and code checkers/linters. -Nil (the default) applies a color-coded underline to the affected -text, while it leaves the original foreground in tact. If the +The value is a list of properties, each designated by a symbol. +The default (nil) applies a color-coded underline to the affected +text, while it leaves the original foreground intact. If the display spec of Emacs has support for it, the underline's style is that of a wave, otherwise it is a straight line. -Options `subtle-foreground' and `intense-foreground' add a -color-coded underline while also changing the text's foreground -accordingly. The style of the underline is the same as with the -default option. +The property `straight-underline' ensures that the underline +under the affected text is always drawn as a straight line. + +The property `text-also' applies the same color of the underline +to the affected text. + +The property `background' adds a color-coded background. + +The property `intense' amplifies the applicable colors if +`background' and/or `text-only' are set. If `intense' is set on +its own, then it implies `text-only'. -Option `straight-underline' is like the default but always -applies a straight line under the affected text. Same principle -for `subtle-foreground-straight-underline' and its counterpart -`intense-foreground-straight-underline'. +To disable fringe indicators for Flymake or Flycheck, refer to +variables `flymake-fringe-indicator-position' and +`flycheck-indication-mode', respectively. -Option `colored-background' uses a straight underline, a -background, and a foreground. All are color-coded. This is the -most intense combination of face properties." +Combinations of any of those properties can be expressed in a +list, as in those examples: + + (background) + (straight-underline intense) + (background text-also straight-underline) + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + + (setq modus-themes-lang-checkers '(text-also background)) + +NOTE: The placement of the straight underline, though not the +wave style, is controlled by the built-in variables +`underline-minimum-offset', `x-underline-at-descent-line', +`x-use-underline-position-properties'." :group 'modus-themes - :package-version '(modus-themes . "1.1.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Only color-coded wavy underline (default)" nil) - (const :format "[%v] %t\n" :tag "Like the default, but with a straight underline" straight-underline) - (const :format "[%v] %t\n" :tag "Color-coded wavy underline; subtle foreground" subtle-foreground) - (const :format "[%v] %t\n" :tag "Combines `straight-underline' and `subtle-foreground'" subtle-foreground-straight-underline) - (const :format "[%v] %t\n" :tag "Color-coded wavy underline; intense foreground" intense-foreground) - (const :format "[%v] %t\n" :tag "Combines `straight-underline' and `intense-foreground'" intense-foreground-straight-underline) - (const :format "[%v] %t\n" :tag "Color-coded background, foreground, straight underline" colored-background)) + :type '(set :tag "Properties" :greedy t + (const :tag "Straight underline" straight-underline) + (const :tag "Colorise text as well" text-also) + (const :tag "Increase color intensity" intense) + (const :tag "With background" background)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Language checkers")) (defcustom modus-themes-org-blocks nil @@ -1971,10 +2327,14 @@ respectively." (const :format "[%v] %t\n" :tag "Alias for `gray-background'" greyscale) (const :format "[%v] %t\n" :tag "Color-coded background per programming language" tinted-background) (const :format "[%v] %t\n" :tag "Alias for `tinted-background'" rainbow)) ; back compat + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Org mode blocks")) (defcustom modus-themes-org-habit nil - "Control the presentation of the `org-habit' graph. + "Deprecated in version 1.5.0 favor of `modus-themes-org-agenda'. + +Control the presentation of the `org-habit' graph. The default is meant to conform with the original aesthetic of `org-habit'. It employs all four color codes that correspond to @@ -2009,64 +2369,90 @@ highlights the alert and overdue states." (const :format "[%v] %t\n" :tag "Respect the original design of org-habit (default)" nil) (const :format "[%v] %t\n" :tag "Like the default, but do not distinguish between present and future variants" simplified) (const :format "[%v] %t\n" :tag "Like `simplified', but only use red, yellow, green" traffic-light)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Org agenda habits")) +(make-obsolete 'modus-themes-org-habit 'modus-themes-org-agenda "1.5.0") + (defcustom modus-themes-mode-line nil - "Adjust the overall style of the mode line. - -The default (nil) is a two-dimensional rectangle with a border -around it. The active and the inactive mode lines use different -shades of grayscale values for the background and foreground. - -A `3d' value will apply a three-dimensional effect to the active -mode line. The inactive mode lines remain two-dimensional and -are toned down a bit, relative to the nil value. - -The `moody' option is meant to optimize the mode line for use -with the library of the same name. This practically means to -remove the box effect and rely on underline and overline -properties instead. It also tones down the inactive mode lines. -Despite its intended purpose, this option can also be used -without the `moody' library. - -The `borderless' option uses the same colors as the default (nil -value), but removes the border effect. This is done by making -the box property use the same color as the background, -effectively blending the two and creating some padding. - -The `borderless-3d' and `borderless-moody' approximate the `3d' -and `moody' options respectively, while removing the borders. -However, to ensure that the inactive mode lines remain visible, -they apply a slightly more prominent background to them than what -their counterparts do (same inactive background as with the -default). - -Similarly, `accented', `accented-3d', and `accented-moody' -correspond to the default (nil), `3d', and `moody' styles -respectively, except that the active mode line uses a colored -background instead of the standard shade of gray. - -Same principle for styles `borderless-accented', -`borderless-accented-3d', `borderless-accented-moody', which -apply a colored background to the active mode line, while they -remove any noticeable border around both the active and inactive -the mode lines." + "Control the overall style of the mode line. + +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) is a two-dimensional +rectangle with a border around it. The active and the inactive +mode lines use different shades of grayscale values for the +background, foreground, border. + +The `3d' property applies a three-dimensional effect to the +active mode line. The inactive mode lines remain two-dimensional +and are toned down a bit, relative to the default style. + +The `moody' property optimizes the mode line for use with the +library of the same name (hereinafter referred to as 'Moody'). +In practice, it removes the box effect and replaces it with +underline and overline properties. It also tones down the +inactive mode lines. Despite its intended purpose, this option +can also be used without the Moody library (please consult the +themes' manual on this point for more details). If both `3d' and +`moody' properties are set, the latter takes precedence. + +The `borderless' property removes the color of the borders. It +does not actually remove the borders, but only makes their color +the same as the background, effectively creating some padding. + +The `accented' property ensures that the active mode line uses a +colored background instead of the standard shade of gray. + +Combinations of any of those properties are expressed as a list, +like in these examples: + + (accented) + (borderless 3d) + (moody accented borderless) + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + + (setq modus-themes-mode-line '(borderless accented)) + +Note that Moody does not expose any faces that the themes could +style directly. Instead it re-purposes existing ones to render +its tabs and ribbons. As such, there may be cases where the +contrast ratio falls below the 7:1 target that the themes conform +with (WCAG AAA). To hedge against this, we configure a fallback +foreground for the `moody' property, which will come into effect +when the background of the mode line changes to something less +accessible, such as Moody ribbons (read the doc string of +`set-face-attribute', specifically `:distant-foreground'). This +fallback is activated when Emacs determines that the background +and foreground of the given construct are too close to each other +in terms of color distance. In practice, users will need to +experiment with the variable `face-near-same-color-threshold' to +trigger the effect. We find that a value of 45000 shall suffice, +contrary to the default 30000. Though for the combinations that +involve the `accented' and `moody' properties, as mentioned +above, that should be raised up to 70000. Do not set it too +high, because it has the adverse effect of always overriding the +default colors (which have been carefully designed to be highly +accessible). + +Furthermore, because Moody expects an underline and overline +instead of a box style, it is advised to set +`x-underline-at-descent-line' to a non-nil value." :group 'modus-themes - :package-version '(modus-themes . "1.4.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Two-dimensional box (default)" nil) - (const :format "[%v] %t\n" :tag "Three-dimensional style for the active mode line" 3d) - (const :format "[%v] %t\n" :tag "No box effects, which are optimal for use with the `moody' library" moody) - (const :format "[%v] %t\n" :tag "Like the default, but without discernible border effects" borderless) - (const :format "[%v] %t\n" :tag "Like `3d', but without noticeable border" borderless-3d) - (const :format "[%v] %t\n" :tag "Like `moody', but without noticeable border" borderless-moody) - (const :format "[%v] %t\n" :tag "Two-dimensional box with a colored background" accented) - (const :format "[%v] %t\n" :tag "Like `3d', but with a colored background" accented-3d) - (const :format "[%v] %t\n" :tag "Like `moody', but with a colored background" accented-moody) - (const :format "[%v] %t\n" :tag "Like `accented', but without a noticeable border" borderless-accented) - (const :format "[%v] %t\n" :tag "Like `accented-3d', but with a noticeable border" borderless-accented-3d) - (const :format "[%v] %t\n" :tag "Like `accented-moody', but with a noticeable border" borderless-accented-moody)) + :type '(set :tag "Properties" :greedy t + (choice :tag "Overall style" + (const :tag "Rectangular Border" nil) + (const :tag "3d borders" 3d) + (const :tag "No box effects (Moody-compatible)" moody)) + (const :tag "Colored background" accented) + (const :tag "Without border color" borderless)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Mode line")) (defcustom modus-themes-diffs nil @@ -2108,10 +2494,12 @@ interest of backward compatibility." :type '(choice (const :format "[%v] %t\n" :tag "Intensely colored backgrounds (default)" nil) (const :format "[%v] %t\n" :tag "Slightly accented backgrounds with tinted text" desaturated) - (const :format "[%v] %t\n" :tag "Apply color-coded backgrounds; keep syntax colors in tact" bg-only) + (const :format "[%v] %t\n" :tag "Apply color-coded backgrounds; keep syntax colors intact" bg-only) (const :format "[%v] %t\n" :tag "Like the default (nil), though optimized for red-green color defficiency" deuteranopia) (const :format "[%v] %t\n" :tag "No backgrounds, except for refined diffs" fg-only-deuteranopia) (const :format "[%v] %t\n" :tag "Alias of `fg-only-deuteranopia' for backward compatibility" fg-only)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Diffs")) (defcustom modus-themes-completions nil @@ -2155,36 +2543,57 @@ and `opinionated' possibilities." (const :format "[%v] %t\n" :tag "Respect the framework's established aesthetic (default)" nil) (const :format "[%v] %t\n" :tag "Subtle backgrounds for various elements" moderate) (const :format "[%v] %t\n" :tag "Radical alternative to the framework's looks" opinionated)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Completion UIs")) (defcustom modus-themes-prompts nil "Use subtle or intense styles for minibuffer and REPL prompts. -Nil means to only use an accented foreground color. +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) means to only use a +subtle accented foreground color. + +The property `background' applies a background color to the +prompt's text. By default, this is a subtle accented value. + +The property `intense' makes the foreground color more prominent. +If the `background' property is also set, it amplifies the value +of the background as well. + +The property `gray' changes the prompt's colors to grayscale. +This affects the foreground and, if the `background' property is +also set, the background. Its effect is subtle, unless it is +combined with the `intense' property. + +The property `bold' makes the text use a bold typographic weight. +Similarly, `italic' adds a slant to the font's forms (italic or +oblique forms, depending on the typeface). + +Combinations of any of those properties are expressed as a list, +like in these examples: -Options `subtle-accented' and `intense-accented' will change both -the background and the foreground values to use accented color -combinations that follow the hue of the default styles' -foreground (e.g. the default minibuffer prompt is cyan text, so -these combinations will involved a cyan background and an -appropriate cyan foreground). + (intense) + (bold intense) + (intense bold gray) + (intense background gray bold) -Options `subtle-gray' and `intense-gray' are like their -`subtle-accented' and `intense-accented' counterparts, except -they use grayscale values instead of accented ones." +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + + (setq modus-themes-prompts '(background gray))" :group 'modus-themes - :package-version '(modus-themes . "1.1.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" - :type '(choice - ;; `subtle' is the same as `subtle-accented', while `intense' is - ;; equal to `intense-accented' for backward compatibility - (const :format "[%v] %t\n" :tag "No prompt background (default)" nil) - (const :format "[%v] %t\n" :tag "Subtle accented background for the prompt" subtle-accented) - (const :format "[%v] %t\n" :tag "Same as `subtle-accented' for compatibility with older versions" subtle) - (const :format "[%v] %t\n" :tag "Intense accented background and foreground for the prompt" intense-accented) - (const :format "[%v] %t\n" :tag "Same as `intense-accented' for compatibility with older versions" intense) - (const :format "[%v] %t\n" :tag "Like `subtle-accented' but grayscale" subtle-gray) - (const :format "[%v] %t\n" :tag "Like `intense-accented' but grayscale" intense-gray)) + :type '(set :tag "Properties" :greedy t + (const :tag "With Background" background) + (const :tag "Intense" intense) + (const :tag "Grayscale" gray) + (const :tag "Bold font weight" bold) + (const :tag "Italic font slant" italic)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Command prompts")) (defcustom modus-themes-intense-hl-line nil @@ -2193,6 +2602,8 @@ they use grayscale values instead of accented ones." :package-version '(modus-themes . "1.0.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Line highlighting")) (make-obsolete 'modus-themes-intense-hl-line 'modus-themes-hl-line "1.3.0") @@ -2200,39 +2611,44 @@ they use grayscale values instead of accented ones." (defcustom modus-themes-hl-line nil "Control the current line highlight of HL-line mode. -The default (nil) is to apply a subtle neutral background to the -current line. +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) is a subtle gray +background color. -Option `intense-background' uses a prominent neutral background. +The property `accented' changes the background to a colored +variant. -Option `accented-background' is like the `intense-background' but -with a more colorful background. +An `underline' property draws a line below the highlighted area. +Its color is similar to the background, so gray by default or an +accent color when `accented' is also set. -Option `underline-neutral' combines a subtle neutral background -with a gray underline. +An `intense' property amplifies the colors in use, which may be +both the background and the underline. -Option `underline-accented' draws an underline while applying a -subtle colored background. +Combinations of any of those properties are expressed as a list, +like in these examples: -Option `underline-only-neutral' uses just a neutral underline, -without any added change to the background. + (intense) + (underline intense) + (accented intense underline) -Option `underline-only-accented' uses just a colored underline, -without any added change to the background. +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + + (setq modus-themes-hl-line '(underline accented)) Set `x-underline-at-descent-line' to a non-nil value for better results with underlines." :group 'modus-themes - :package-version '(modus-themes . "1.4.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Subtle neutral background (default)" nil) - (const :format "[%v] %t\n" :tag "Prominent neutral background" intense-background) - (const :format "[%v] %t\n" :tag "Subtle colored background" accented-background) - (const :format "[%v] %t\n" :tag "Underline with a subtle neutral background" underline-neutral) - (const :format "[%v] %t\n" :tag "Underline with a subtle colored background" underline-accented) - (const :format "[%v] %t\n" :tag "Just a neutral underline, without a background" underline-only-neutral) - (const :format "[%v] %t\n" :tag "Just an accented underline, without a background" underline-only-accented)) + :type '(set :tag "Properties" :greedy t + (const :tag "Colored background" accented) + (const :tag "Underline" underline) + (const :tag "Intense style" intense)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Line highlighting")) (defcustom modus-themes-subtle-line-numbers nil @@ -2241,145 +2657,208 @@ results with underlines." :package-version '(modus-themes . "1.2.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Line numbers")) (defcustom modus-themes-paren-match nil - "Choose the style of matching parentheses or delimiters. + "Control the style of matching parentheses or delimiters. -Nil means to use a subtle tinted background color (the default). +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) is a subtle background +color. -Option `intense' applies a saturated background color. +The `bold' property adds a bold weight to the characters of the +matching delimiters. -Option `subtle-bold' is the same as the default, but also makes -use of bold typographic weight (inherits the `bold' face). +The `intense' property applies a more prominent background color +to the delimiters. -Option `intense-bold' is the same as `intense', while it also -uses a bold weight." +The `underline' property draws a straight line under the affected +text. + +Combinations of any of those properties are expressed as a list, +like in these examples: + + (bold) + (underline intense) + (bold intense underline) + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + + (setq modus-themes-paren-match '(bold intense))" :group 'modus-themes - :package-version '(modus-themes . "1.0.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Sublte tinted background (default)" nil) - (const :format "[%v] %t\n" :tag "Like the default, but also use bold typographic weight" subtle-bold) - (const :format "[%v] %t\n" :tag "Intense saturated background" intense) - (const :format "[%v] %t\n" :tag "Like `intense' but with bold weight" intense-bold)) + :type '(set :tag "Properties" :greedy t + (const :tag "Bold weight" bold) + (const :tag "Intense background color" intense) + (const :tag "Underline" underline)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Matching parentheses")) (defcustom modus-themes-syntax nil "Control the overall style of code syntax highlighting. -Nil (the default) means to use colors on the cyan-blue-magenta -side of the spectrum. There is little to no use of greens, -yellows, and reds. +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) is to use a balanced +combination of colors on the cyan-blue-magenta side of the +spectrum. There is little to no use of greens, yellows, and +reds. Comments are gray, strings are blue colored, doc strings +are a shade of cyan, while color combinations are designed to +avoid exaggerations. + +The property `faint' fades the saturation of all applicable +colors, where that is possible or appropriate. -Option `faint' is like the default in terms of the choice of -palette but applies desaturated color values. +The property `yellow-comments' applies a yellow color to +comments. -Option `yellow-comments' applies a yellow tint to comments. The -rest of the syntax is the same as the default. +The property `green-strings' applies a green color to strings and +a green tint to doc strings. -Option `green-strings' replaces the blue/cyan/cold color variants -in strings with greener alternatives. The rest of the syntax -remains the same. +The property `alt-syntax' changes the combination of colors +beyond strings and comments, so that the effective palette is +broadened to provide greater variety relative to the default. -Option `yellow-comments-green-strings' combines yellow comments -with green strings and the rest of the default syntax -highlighting style. +Combinations of any of those properties are expressed as a list, +like in these examples: -Option `alt-syntax' expands the color palette and applies new -color combinations. Strings are green. Doc strings are magenta -tinted. Comments are gray. + (faint) + (green-strings yellow-comments) + (alt-syntax green-strings yellow-comments) + (faint alt-syntax green-strings yellow-comments) -Option `alt-syntax-yellow-comments' combines `alt-syntax' with -`yellow-comments'. +The order in which the properties are set is not significant. -Option `faint-yellow-comments' combines the `faint' style with -`yellow-comments'." +In user configuration files the form may look like this: + + (setq modus-themes-syntax '(faint alt-syntax)) + +Independent of this variable, users may also control the use of a +bold weight or italic text: `modus-themes-bold-constructs' and +`modus-themes-italic-constructs'." :group 'modus-themes - :package-version '(modus-themes . "1.2.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Balanced use of blue, cyan, magenta, purple variants (default)" nil) - (const :format "[%v] %t\n" :tag "Like the default, but with desaturated color values" faint) - (const :format "[%v] %t\n" :tag "Apply yellow tint to comments, keep the default style for the rest" yellow-comments) - (const :format "[%v] %t\n" :tag "Use green for strings, keep the default style for the rest" green-strings) - (const :format "[%v] %t\n" :tag "Use green for strings, yellow for comments, keep the default style for the rest" yellow-comments-green-strings) - (const :format "[%v] %t\n" :tag "Refashion syntax highlighting with more colors, gray comments" alt-syntax) - (const :format "[%v] %t\n" :tag "Like `alt-syntax' but with yellow comments" alt-syntax-yellow-comments) - (const :format "[%v] %t\n" :tag "Like `faint' but with yellow comments" faint-yellow-comments)) + :type '(set :tag "Properties" :greedy t + (const :tag "Faint colors" faint) + (const :tag "Yellow comments" yellow-comments) + (const :tag "Green strings" green-strings) + (const :tag "Alternative set of colors" alt-syntax)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Syntax styles")) (defcustom modus-themes-links nil "Set the style of links. -Nil means to use an underline that is the same color as the -foreground. +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) is a prominent text +color, typically blue, with an underline of the same color. + +For the style of the underline, a `neutral-underline' property +turns the color of the line into a subtle gray, while the +`no-underline' property removes the line altogether. If both of +those are set, the latter takes precedence. + +For text coloration, a `faint' property desaturates the color of +the text and the underline, unless the underline is affected by +the aforementioned properties. While a `no-color' property +removes the color from the text. If both of those are set, the +latter takes precedence. + +A `bold' property applies a heavy typographic weight to the text +of the link. + +An `italic' property adds a slant to the link's text (italic or +oblique forms, depending on the typeface). -Option `faint' applies desaturated colors to the link's text and -underline. +A `background' property applies a subtle tinted background color. -Option `neutral-underline' applies a subtle gray underline, while -retaining the link's foreground. +In case both `no-underline' and `no-color' are set, then a subtle +gray background is applied to all links. This can still be +combined with the `bold' and `italic' properties. -Option `faint-neutral-underline' combines a desaturated text -color with a subtle gray underline. +Combinations of any of those properties are expressed as a list, +like in these examples: -Option `no-underline' removes link underlines altogether, while -retaining their original fairly vivid color. + (faint) + (no-underline faint) + (no-color no-underline bold) + (italic bold background no-color no-underline) -Option `underline-only' applies an underline while making the -affected text colorless (it uses the same foreground as the -theme's default). +The order in which the properties are set is not significant. -Option `neutral-underline-only' makes the text colorless while -using a subtle underline below it." +In user configuration files the form may look like this: + + (setq modus-themes-links '(neutral-underline background)) + +The placement of the underline, meaning its proximity to the +text, is controlled by `x-use-underline-position-properties', +`x-underline-at-descent-line', `underline-minimum-offset'. +Please refer to their documentation strings." :group 'modus-themes - :package-version '(modus-themes . "1.2.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Undeline link using the same color as the text (default)" nil) - (const :format "[%v] %t\n" :tag "Like the default, but apply less intense colors to links" faint) - (const :format "[%v] %t\n" :tag "Change the color of link underlines to a neutral gray" neutral-underline) - (const :format "[%v] %t\n" :tag "Desaturated foreground with neutral gray underline" faint-neutral-underline) - (const :format "[%v] %t\n" :tag "Remove underline property from links, keeping their foreground as-is" no-underline) - (const :format "[%v] %t\n" :tag "Apply underline only; use default foreground" underline-only) - (const :format "[%v] %t\n" :tag "Like `underline-only' but with a subtle underline" neutral-underline-only)) + :type '(set :tag "Properties" :greedy t + (choice :tag "Text coloration" + (const :tag "Saturared color (default)" nil) + (const :tag "Faint coloration" faint) + (const :tag "No color (use main black/white)" no-color)) + (choice :tag "Underline" + (const :tag "Same color as text (default)" nil) + (const :tag "Neutral (gray) underline color" neutral-underline) + (const :tag "No underline" no-underline)) + (const :tag "Bold font weight" bold) + (const :tag "Italic font slant" italic) + (const :tag "Subtle background color" background)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Link styles")) (defcustom modus-themes-region nil - "Change the overall appearance of the active region. + "Control the overall style of the active region. -Nil (the default) means to only use a prominent gray background -with a neutral foreground. The foreground overrides all syntax -highlighting. The region extends to the edge of the window. +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) is a prominent gray +background that overrides all foreground colors in the area it +encompasses. Its reach extends to the edge of the window. -Option `no-extend' preserves the default aesthetic but prevents -the region from extending to the edge of the window. +The `no-extend' property limits the region to the end of the +line, so that it does not reach the edge of the window. -Option `bg-only' applies a faint tinted background that is -distinct from all others used in the theme, while it does not -override any existing colors. It extends to the edge of the -window. +The `bg-only' property makes the region's background color more +subtle to allow the underlying text to retain its foreground +colors. -Option `bg-only-no-extend' is a combination of the `bg-only' and -`no-extend' options. +The `accented' property applies a more colorful background to the +region. -Option `accent' uses a more colorful background with a neutral -foreground. It overrides all syntax highlighting and extends to -the edge of the window. +Combinations of any of those properties are expressed as a list, +like in these examples: -Option `accent-no-extend' is like the above, but stretches only -to the end of each line within the region." + (no-extend) + (bg-only accented) + (accented bg-only no-extend) + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + + (setq modus-themes-region '(bg-only no-extend))" :group 'modus-themes - :package-version '(modus-themes . "1.3.0") + :package-version '(modus-themes . "1.5.0") :version "28.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Intense background; overrides colors; extends to edge of window (default)" nil) - (const :format "[%v] %t\n" :tag "As with the default, but does not extend" no-extend) - (const :format "[%v] %t\n" :tag "Subtle background; preserves colors; extends to edge of window" bg-only) - (const :format "[%v] %t\n" :tag "As with the `subtle' option, but does not extend" bg-only-no-extend) - (const :format "[%v] %t\n" :tag "Like the default, but with an accented background" accent) - (const :format "[%v] %t\n" :tag "As with the `accent' option, but does not extend" accent-no-extend)) + :type '(set :tag "Properties" :greedy t + (const :tag "Do not extend to the edge of the window" no-extend) + (const :tag "Background only (preserve underlying colors)" bg-only) + (const :tag "Accented background" accented)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Active region")) (defcustom modus-themes-success-deuteranopia nil @@ -2397,6 +2876,8 @@ configured to conform with deuteranopia: `modus-themes-diffs'." :package-version '(modus-themes . "1.4.0") :version "28.1" :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Success' color-code")) (defcustom modus-themes-mail-citations nil @@ -2420,6 +2901,8 @@ colored into a uniform shade of shade of gray." (const :format "[%v] %t\n" :tag "Like the default, but with less saturated colors" faint) (const :format "[%v] %t\n" :tag "Deprecated alias of `faint'" desaturated) (const :format "[%v] %t\n" :tag "Uniformly gray mail citations" monochrome)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Mail citations")) @@ -2474,17 +2957,17 @@ Those are stored in `modus-themes-faces' and (when modus-themes-bold-constructs (list :inherit 'bold))) -(defun modus-themes--mixed-fonts () - "Conditional application of `fixed-pitch' inheritance." - (unless modus-themes-no-mixed-fonts - (list :inherit 'fixed-pitch))) - (defun modus-themes--slant () "Conditional use of italics for slant attribute." - (if modus-themes-slanted-constructs + (if modus-themes-italic-constructs (list 'italic) (list 'normal))) +(defun modus-themes--fixed-pitch () + "Conditional application of `fixed-pitch' inheritance." + (unless modus-themes-no-mixed-fonts + (list :inherit 'fixed-pitch))) + (defun modus-themes--variable-pitch () "Conditional use of `variable-pitch' in headings." (when modus-themes-variable-pitch-headings @@ -2512,43 +2995,113 @@ combines with the theme's primary background (white/black)." (list :background (or altbg 'unspecified) :foreground altfg) (list :background mainbg :foreground mainfg))) -(defun modus-themes--lang-check (underline subtlefg intensefg bg) +(defun modus-themes--lang-check (underline subtlefg intensefg intensefg-alt subtlebg intensebg) "Conditional use of foreground colors for language checkers. UNDERLINE is a color-code value for the affected text's underline property. SUBTLEFG and INTENSEFG follow the same color-coding pattern and represent a value that is faint or vibrant -respectively. BG is a color-coded background." - (pcase modus-themes-lang-checkers - ('colored-background - (list :underline underline :background bg :foreground intensefg)) - ('intense-foreground - (list :underline (list :color underline :style 'wave) :foreground intensefg)) - ('intense-foreground-straight-underline - (list :underline underline :foreground intensefg)) - ('subtle-foreground - (list :underline (list :color underline :style 'wave) :foreground subtlefg)) - ('subtle-foreground-straight-underline - (list :underline underline :foreground subtlefg)) - ('straight-underline - (list :underline underline)) - (_ (list :underline (list :color underline :style 'wave))))) - -(defun modus-themes--prompt (mainfg subtlebg subtlefg intensebg intensefg) - "Conditional use of background colors for prompts. -MAINFG is the prompt's standard foreground. SUBTLEBG should be a -subtle accented background that works with SUBTLEFG. INTENSEBG -must be a more pronounced accented color that should be -combinable with INTENSEFG." - (pcase modus-themes-prompts - ;; `subtle' is the same as `subtle-accented', while `intense' is - ;; equal to `intense-accented' for backward compatibility - ('intense-accented (list :background intensebg :foreground intensefg)) - ('intense (list :background intensebg :foreground intensefg)) - ('subtle-accented (list :background subtlebg :foreground subtlefg)) - ('subtle (list :background subtlebg :foreground subtlefg)) - ('subtle-gray (list :inherit 'modus-themes-subtle-neutral)) - ('intense-gray (list :inherit 'modus-themes-intense-neutral)) - (_ (list :background 'unspecified :foreground mainfg)))) +respectively. INTENSEFG-ALT is used when the intensity is high. +SUBTLEBG and INTENSEBG are color-coded background colors that +differ in overall intensity." + (let ((modus-themes-lang-checkers + (if (listp modus-themes-lang-checkers) + modus-themes-lang-checkers + (pcase modus-themes-lang-checkers + ('colored-background '(background intense)) + ('intense-foreground '(intense)) + ('intense-foreground-straight-underline '(intense straight-underline)) + ('subtle-foreground '(text-also)) + ('subtle-foreground-straight-underline '(text-also straight-underline)) + ('straight-underline '(straight-underline)))))) + (list :underline + (list :color + underline + :style + (if (memq 'straight-underline modus-themes-lang-checkers) + 'line 'wave)) + :background + (cond + ((and (memq 'background modus-themes-lang-checkers) + (memq 'intense modus-themes-lang-checkers)) + intensebg) + ((memq 'background modus-themes-lang-checkers) + subtlebg)) + :foreground + (cond + ((and (memq 'background modus-themes-lang-checkers) + (memq 'intense modus-themes-lang-checkers)) + intensefg-alt) + ((memq 'intense modus-themes-lang-checkers) + intensefg) + ((memq 'text-also modus-themes-lang-checkers) + subtlefg))))) + +(defun modus-themes--prompt (mainfg intensefg grayfg subtlebg intensebg intensebg-fg subtlebggray intensebggray) + "Conditional use of colors for prompts. +MAINFG is the prompt's standard foreground. INTENSEFG is a more +prominent alternative to the main foreground, while GRAYFG is a +less luminant shade of gray. + +SUBTLEBG is a subtle accented background that works with either +MAINFG or INTENSEFG. + +INTENSEBG is a more pronounced accented background color that +should be combinable with INTENSEBG-FG. + +SUBTLEBGGRAY and INTENSEBGGRAY are background values. The former +can be combined with GRAYFG, while the latter only works with the +theme's fallback text color." + (let ((modus-themes-prompts + (if (listp modus-themes-prompts) + modus-themes-prompts + ;; translation layer for legacy values + (pcase modus-themes-prompts + ;; `subtle' is the same as `subtle-accented', while `intense' is + ;; equal to `intense-accented' for backward compatibility + ('subtle '(background)) + ('subtle-accented '(background)) + ('subtle-gray '(background gray)) + ('intense '(background intense)) + ('intense-accented '(background intense)) + ('intense-gray '(background intense gray)))))) + (list :foreground + (cond + ((and (memq 'gray modus-themes-prompts) + (memq 'intense modus-themes-prompts)) + 'unspecified) + ((memq 'gray modus-themes-prompts) + grayfg) + ((and (memq 'background modus-themes-prompts) + (memq 'intense modus-themes-prompts)) + intensebg-fg) + ((memq 'intense modus-themes-prompts) + intensefg) + (mainfg)) + :background + (cond + ((and (memq 'gray modus-themes-prompts) + (memq 'background modus-themes-prompts) + (memq 'intense modus-themes-prompts)) + intensebggray) + ((and (memq 'gray modus-themes-prompts) + (memq 'background modus-themes-prompts)) + subtlebggray) + ((and (memq 'background modus-themes-prompts) + (memq 'intense modus-themes-prompts)) + intensebg) + ((memq 'background modus-themes-prompts) + subtlebg) + ('unspecified)) + :inherit + (cond + ((and (memq 'bold modus-themes-prompts) + (memq 'italic modus-themes-prompts)) + 'bold-italic) + ((memq 'italic modus-themes-prompts) + 'italic) + ((memq 'bold modus-themes-prompts) + 'bold) + ('unspecified))))) (defun modus-themes--paren (normalbg intensebg) "Conditional use of intense colors for matching parentheses. @@ -2556,127 +3109,278 @@ NORMALBG should be the special palette color 'bg-paren-match' or something similar. INTENSEBG must be easier to discern next to other backgrounds, such as the special palette color 'bg-paren-match-intense'." - (pcase modus-themes-paren-match - ('subtle-bold (list :inherit 'bold :background normalbg)) - ('intense-bold (list :inherit 'bold :background intensebg)) - ('intense (list :background intensebg)) - (_ (list :background normalbg)))) + (let ((modus-themes-paren-match + (if (listp modus-themes-paren-match) + modus-themes-paren-match + ;; translation layer for legacy values + (pcase modus-themes-paren-match + ;; `subtle' is the same as `subtle-accented', while `intense' is + ;; equal to `intense-accented' for backward compatibility + ('intense-bold '(intense bold)) + ('subtle-bold '(bold)) + ('intense '(intense)))))) + (list :inherit + (if (memq 'bold modus-themes-paren-match) + 'bold + 'unspecified) + :background + (if (memq 'intense modus-themes-paren-match) + intensebg + normalbg) + :underline + (if (memq 'underline modus-themes-paren-match) + t + nil)))) (defun modus-themes--syntax-foreground (fg faint) "Apply foreground value to code syntax. FG is the default. FAINT is typically the same color in its desaturated version." - (pcase modus-themes-syntax - ('faint (list :foreground faint)) - ('faint-yellow-comments (list :foreground faint)) - (_ (list :foreground fg)))) - -(defun modus-themes--syntax-extra (fg faint alt) + (let ((modus-themes-syntax + (if (listp modus-themes-syntax) + modus-themes-syntax + ;; translation layer for legacy values + (pcase modus-themes-syntax + ('faint '(faint)) + ('faint-yellow-comments '(faint yellow-comments)) + ('green-strings '(green-strings)) + ('yellow-comments '(yellow-comments)) + ('yellow-comments-green-strings '(green-strings yellow-comments)) + ('alt-syntax '(alt-syntax)) + ('alt-syntax-yellow-comments '(alt-syntax yellow-comments)))))) + (list :foreground + (cond + ((memq 'faint modus-themes-syntax) + faint) + (fg))))) + +(defun modus-themes--syntax-extra (fg faint alt &optional faint-alt) "Apply foreground value to code syntax. FG is the default. FAINT is typically the same color in its -desaturated version. ALT is another hue." - (pcase modus-themes-syntax - ('faint (list :foreground faint)) - ('faint-yellow-comments (list :foreground faint)) - ('alt-syntax (list :foreground alt)) - ('alt-syntax-yellow-comments (list :foreground alt)) - (_ (list :foreground fg)))) - -(defun modus-themes--syntax-string (fg faint green alt) - "Apply foreground value to strings in code syntax. -FG is the default. FAINT is typically the same color in its -desaturated version. GREEN is a color variant in that side of -the spectrum. ALT is another hue." - (pcase modus-themes-syntax - ('faint (list :foreground faint)) - ('faint-yellow-comments (list :foreground faint)) - ('green-strings (list :foreground green)) - ('yellow-comments-green-strings (list :foreground alt)) - ('alt-syntax (list :foreground alt)) - ('alt-syntax-yellow-comments (list :foreground alt)) - (_ (list :foreground fg)))) - -(defun modus-themes--syntax-docstring (fg faint green alt) +desaturated version. ALT is another hue while optional FAINT-ALT +is its subtle alternative." + (let ((modus-themes-syntax + (if (listp modus-themes-syntax) + modus-themes-syntax + ;; translation layer for legacy values + (pcase modus-themes-syntax + ('faint '(faint)) + ('faint-yellow-comments '(faint yellow-comments)) + ('green-strings '(green-strings)) + ('yellow-comments '(yellow-comments)) + ('yellow-comments-green-strings '(green-strings yellow-comments)) + ('alt-syntax '(alt-syntax)) + ('alt-syntax-yellow-comments '(alt-syntax yellow-comments)))))) + (list :foreground + (cond + ((and (memq 'alt-syntax modus-themes-syntax) + (memq 'faint modus-themes-syntax)) + (or faint-alt alt)) + ((memq 'faint modus-themes-syntax) + faint) + ((memq 'alt-syntax modus-themes-syntax) + alt) + (fg))))) + +(defun modus-themes--syntax-string (fg faint green alt &optional faint-green faint-alt) "Apply foreground value to strings in code syntax. FG is the default. FAINT is typically the same color in its desaturated version. GREEN is a color variant in that side of -the spectrum. ALT is another hue." - (pcase modus-themes-syntax - ('faint (list :foreground faint)) - ('faint-yellow-comments (list :foreground faint)) - ('green-strings (list :foreground green)) - ('yellow-comments-green-strings (list :foreground green)) - ('alt-syntax (list :foreground alt)) - ('alt-syntax-yellow-comments (list :foreground alt)) - (_ (list :foreground fg)))) - -(defun modus-themes--syntax-comment (fg yellow) +the spectrum. ALT is another hue. Optional FAINT-GREEN is a +subtle alternative to GREEN. Optional FAINT-ALT is a subtle +alternative to ALT." + (let ((modus-themes-syntax + (if (listp modus-themes-syntax) + modus-themes-syntax + ;; translation layer for legacy values + (pcase modus-themes-syntax + ('faint '(faint)) + ('faint-yellow-comments '(faint yellow-comments)) + ('green-strings '(green-strings)) + ('yellow-comments '(yellow-comments)) + ('yellow-comments-green-strings '(green-strings yellow-comments)) + ('alt-syntax '(alt-syntax)) + ('alt-syntax-yellow-comments '(alt-syntax yellow-comments)))))) + (list :foreground + (cond + ((and (memq 'faint modus-themes-syntax) + (memq 'green-strings modus-themes-syntax)) + (or faint-green green)) + ((and (memq 'alt-syntax modus-themes-syntax) + (memq 'faint modus-themes-syntax)) + (or faint-alt faint)) + ((memq 'faint modus-themes-syntax) + faint) + ((memq 'green-strings modus-themes-syntax) + green) + ((memq 'alt-syntax modus-themes-syntax) + alt) + (fg))))) + +(defun modus-themes--syntax-comment (fg yellow &optional faint-yellow faint) "Apply foreground value to strings in code syntax. -FG is the default. YELLOW is a color variant of that name." - (pcase modus-themes-syntax - ('yellow-comments (list :foreground yellow)) - ('yellow-comments-green-strings (list :foreground yellow)) - ('alt-syntax-yellow-comments (list :foreground yellow)) - ('faint-yellow-comments (list :foreground yellow)) - (_ (list :foreground fg)))) - -(defun modus-themes--heading-p (key) - "Query style of KEY in `modus-themes-headings'." - (cdr (assoc key modus-themes-headings))) - -(defun modus-themes--heading (level fg fg-alt bg border) +FG is the default. YELLOW is a color variant of that name while +optional FAINT-YELLOW is its subtle variant. Optional FAINT is +an alternative to the default value." + (let ((modus-themes-syntax + (if (listp modus-themes-syntax) + modus-themes-syntax + ;; translation layer for legacy values + (pcase modus-themes-syntax + ('faint '(faint)) + ('faint-yellow-comments '(faint yellow-comments)) + ('green-strings '(green-strings)) + ('yellow-comments '(yellow-comments)) + ('yellow-comments-green-strings '(green-strings yellow-comments)) + ('alt-syntax '(alt-syntax)) + ('alt-syntax-yellow-comments '(alt-syntax yellow-comments)))))) + (list :foreground + (cond + ((and (memq 'faint modus-themes-syntax) + (memq 'yellow-comments modus-themes-syntax)) + (or faint-yellow yellow)) + ((and (memq 'alt-syntax modus-themes-syntax) + (memq 'yellow-comments modus-themes-syntax) + (not (memq 'green-strings modus-themes-syntax))) + (or faint-yellow yellow)) + ((memq 'yellow-comments modus-themes-syntax) + yellow) + ((memq 'faint modus-themes-syntax) + (or faint fg)) + (fg))))) + +(defun modus-themes--key-cdr (key alist) + "Get cdr of KEY in ALIST." + (cdr (assoc key alist))) + +(defun modus-themes--heading (level fg fg-alt bg bg-gray border) "Conditional styles for `modus-themes-headings'. LEVEL is the heading's position in their order. FG is the default text color. FG-ALT is an accented, more saturated value than the default. BG is a nuanced, typically accented, background that can work well with either of the foreground -values. BORDER is a color value that combines well with the -background and alternative foreground." - (let* ((key (modus-themes--heading-p level)) - (style (or key (modus-themes--heading-p t))) - (var (when modus-themes-variable-pitch-headings - 'variable-pitch)) +values. BG-GRAY is a gray background. BORDER is a color value +that combines well with the background and foreground." + (let* ((key (modus-themes--key-cdr level modus-themes-headings)) + (style (or key (modus-themes--key-cdr t modus-themes-headings))) + (modus-themes-headings + (if (listp style) + style + ;; translation layer for legacy values + (pcase style + ('highlight '(background)) + ('highlight-no-bold '(background no-bold)) + ('line '(overline)) + ('line-no-bold '(no-bold overline)) + ('no-bold '(no-bold)) + ('no-color '(monochrome)) + ('no-color-no-bold '(no-bold monochrome)) + ('rainbow '(rainbow)) + ('rainbow-highlight '(rainbow background)) + ('rainbow-highlight-no-bold '(no-bold rainbow background)) + ('rainbow-line '(rainbow overline)) + ('rainbow-no-bold '(no-bold rainbow)) + ('rainbow-line-no-bold '(rainbow overline no-bold)) + ('rainbow-section '(rainbow overline background)) + ('rainbow-section-no-bold '(no-bold rainbow background overline)) + ('section '(background overline)) + ('section-no-bold '(background overline no-bold))))) + (var (if modus-themes-variable-pitch-headings + 'variable-pitch + 'unspecified)) (varbold (if var (append (list 'bold) (list var)) 'bold))) - (pcase style - ('no-bold - (list :inherit var :foreground fg)) - ('no-color - (list :inherit varbold)) - ('no-color-no-bold - (list :inherit var)) - ('line - (list :inherit varbold :foreground fg :overline border)) - ('line-no-bold - (list :inherit var :foreground fg :overline border)) - ('rainbow - (list :inherit varbold :foreground fg-alt)) - ('rainbow-no-bold - (list :inherit var :foreground fg-alt)) - ('rainbow-line - (list :inherit varbold :foreground fg-alt :overline border)) - ('rainbow-line-no-bold - (list :inherit var :foreground fg-alt :overline border)) - ('highlight - (list :inherit varbold :background bg :foreground fg)) - ('highlight-no-bold - (list :inherit var :background bg :foreground fg)) - ('rainbow-highlight - (list :inherit varbold :background bg :foreground fg-alt)) - ('rainbow-highlight-no-bold - (list :inherit var :background bg :foreground fg-alt)) - ('section - (list :inherit varbold :background bg :foreground fg :overline border :extend t)) - ('section-no-bold - (list :inherit var :background bg :foreground fg :overline border :extend t)) - ('rainbow-section - (list :inherit varbold :background bg :foreground fg-alt :overline border :extend t)) - ('rainbow-section-no-bold - (list :inherit var :background bg :foreground fg-alt :overline border :extend t)) - (_ - (list :inherit varbold :foreground fg))))) + (list :inherit + (cond + ((memq 'no-bold modus-themes-headings) + var) + (varbold)) + :background + (cond + ((and (memq 'monochrome modus-themes-headings) + (memq 'background modus-themes-headings)) + bg-gray) + ((memq 'background modus-themes-headings) + bg) + ('unspecified)) + :foreground + (cond + ((memq 'monochrome modus-themes-headings) + 'unspecified) + ((memq 'rainbow modus-themes-headings) + fg-alt) + (fg)) + :overline + (if (memq 'overline modus-themes-headings) + border + 'unspecified)))) + +(defun modus-themes--agenda-structure (fg) + "Control the style of the Org agenda structure. +FG is the foreground color to use." + (let* ((properties (modus-themes--key-cdr 'header-block modus-themes-org-agenda)) + (inherit (cond ((memq 'variable-pitch properties) + (list 'bold 'variable-pitch)) + ('bold))) + (height (cond ((memq 'no-scale properties) + 1.0) + ((memq 'scale-title properties) + modus-themes-scale-title) + (1.15)))) + (list :inherit inherit + :height height + :foreground fg))) + +(defun modus-themes--agenda-date (defaultfg grayscalefg &optional bold workaholicfg grayscaleworkaholicfg) + "Control the style of date headings in Org agenda buffers. +DEFAULTFG is the original accent color for the foreground. +GRAYSCALEFG is a neutral color. Optional BOLD applies a bold +weight. Optional WORKAHOLICFG and GRAYSCALEWORKAHOLICFG are +alternative foreground colors." + (let* ((properties (modus-themes--key-cdr 'header-date modus-themes-org-agenda)) + (weight (cond ((memq 'bold-all properties) + 'bold) + ((and bold (memq 'bold-today properties)) + 'bold) + (t + nil))) + (fg (cond ((and (memq 'grayscale properties) + (memq 'workaholic properties)) + (or grayscaleworkaholicfg grayscalefg)) + ((memq 'grayscale properties) + grayscalefg) + ((memq 'workaholic properties) + (or workaholicfg defaultfg)) + (t + defaultfg)))) + (list :inherit weight + :foreground fg))) + +(defun modus-themes--agenda-scheduled (defaultfg uniformfg rainbowfg) + "Control the style of the Org agenda scheduled tasks. +DEFAULTFG is an accented foreground color that is meant to +differentiate between past or present and future tasks. +UNIFORMFG is a more subtle color that eliminates the color coding +for scheduled tasks. RAINBOWFG is a prominent accent value that +clearly distinguishes past, present, future tasks." + (pcase (modus-themes--key-cdr 'scheduled modus-themes-org-agenda) + ('uniform (list :foreground uniformfg)) + ('rainbow (list :foreground rainbowfg)) + (_ (list :foreground defaultfg)))) + +(defun modus-themes--agenda-habit (default traffic simple &optional traffic-deuteran) + "Specify background values for `modus-themes-org-agenda' habits. +DEFAULT is the original foregrounc color. TRAFFIC is to be used +when the 'traffic-light' style is applied, while SIMPLE +corresponds to the 'simplified style'. Optional TRAFFIC-DEUTERAN +is an alternative to TRAFFIC, meant for deuteranopia." + (pcase (modus-themes--key-cdr 'habit modus-themes-org-agenda) + ('traffic-light (list :background traffic)) + ('traffic-light-deuteranopia (list :background (or traffic-deuteran traffic))) + ('simplified (list :background simple)) + (_ (list :background default)))) (defun modus-themes--org-block (bgblk fgdefault &optional fgblk) "Conditionally set the background of Org blocks. @@ -2715,15 +3419,6 @@ set to `rainbow'." ('rainbow (list :background bgaccent :foreground fgaccent)) (_ (list :background bg :foreground fg)))) -(defun modus-themes--org-habit (default &optional traffic simple) - "Specify background values for `modus-themes-org-habit'. -If no optional TRAFFIC argument is supplied, the DEFAULT is used -instead. Same for SIMPLE." - (pcase modus-themes-org-habit - ('traffic-light (list :background (or traffic default))) - ('simplified (list :background (or simple default))) - (_ (list :background default)))) - (defun modus-themes--mode-line-attrs (fg bg fg-alt bg-alt fg-accent bg-accent border border-3d &optional alt-style border-width fg-distant) "Color combinations for `modus-themes-mode-line'. @@ -2743,51 +3438,60 @@ rectangle that produces the box effect. Optional FG-DISTANT should be close to the main background values. It is intended to be used as a distant-foreground property." - (pcase modus-themes-mode-line - ('3d - `( :background ,bg-alt :foreground ,fg-alt - :box ( :line-width ,(or border-width 1) - :color ,border-3d - :style ,(and alt-style 'released-button)))) - ('moody - `( :background ,bg-alt :foreground ,fg-alt - :underline ,border :overline ,border - :distant-foreground ,fg-distant)) - ('borderless - `(:background ,bg :foreground ,fg :box ,bg)) - ('borderless-3d - `( :background ,bg :foreground ,fg - :box ( :line-width ,(or border-width 1) - :color ,bg - :style ,(and alt-style 'released-button)))) - ('borderless-moody - `( :background ,bg :foreground ,fg - :underline ,bg :overline ,bg - :distant-foreground ,fg-distant)) - ('accented - `(:background ,bg-accent :foreground ,fg-accent :box ,border)) - ('accented-3d - `( :background ,bg-accent :foreground ,fg-accent - :box ( :line-width ,(or border-width 1) - :color ,border-3d - :style ,(and alt-style 'released-button)))) - ('accented-moody - `( :background ,bg-accent :foreground ,fg-accent - :underline ,border :overline ,border - :distant-foreground ,fg-distant)) - ('borderless-accented - `(:background ,bg-accent :foreground ,fg-accent :box ,bg-accent)) - ('borderless-accented-3d - `( :background ,bg-accent :foreground ,fg-accent - :box ( :line-width ,(or border-width 1) - :color ,bg-accent - :style ,(and alt-style 'released-button)))) - ('borderless-accented-moody - `( :background ,bg-accent :foreground ,fg-accent - :underline ,bg-accent :overline ,bg-accent - :distant-foreground ,fg-distant)) - (_ - `(:background ,bg :foreground ,fg :box ,border)))) + (let ((modus-themes-mode-line + (if (listp modus-themes-mode-line) + modus-themes-mode-line + ;; translation layer for legacy values + (alist-get modus-themes-mode-line + '((3d . (3d)) + (moody . (moody)) + (borderless . (borderless)) + (borderless-3d . (borderless 3d)) + (borderless-moody . (borderless moody)) + (accented . (accented)) + (accented-3d . (accented 3d)) + (accented-moody . (accented moody)) + (borderless-accented . (borderless accented)) + (borderless-accented-3d . (borderless accented 3d)) + (borderless-accented-moody . (borderless accented moody))))))) + (let ((base (cond ((memq 'accented modus-themes-mode-line) + (cons fg-accent bg-accent)) + ((and (or (memq 'moody modus-themes-mode-line) + (memq '3d modus-themes-mode-line)) + (not (memq 'borderless modus-themes-mode-line))) + (cons fg-alt bg-alt)) + ((cons fg bg)))) + (box (cond ((memq 'moody modus-themes-mode-line) + nil) + ((memq '3d modus-themes-mode-line) + (list :line-width (or border-width 1) + :color + (cond ((and (memq 'accented modus-themes-mode-line) + (memq 'borderless modus-themes-mode-line)) + bg-accent) + ((memq 'borderless modus-themes-mode-line) bg) + (border-3d)) + :style (and alt-style 'released-button))) + ((or (memq 'borderless modus-themes-mode-line) + (memq 'moody modus-themes-mode-line)) + bg) + (border))) + (line (cond ((not (memq 'moody modus-themes-mode-line)) + nil) + ((and (memq 'borderless modus-themes-mode-line) + (memq 'accented modus-themes-mode-line)) + bg-accent) + ((memq 'borderless modus-themes-mode-line) + bg) + (border)))) + (list :foreground (car base) + :background (cdr base) + :box box + :overline line + :underline line + :distant-foreground + (and (memq 'moody modus-themes-mode-line) + fg-distant))))) (defun modus-themes--diff (fg-only-bg fg-only-fg mainbg mainfg altbg altfg &optional deuteranbg deuteranfg bg-only-fg) @@ -2867,30 +3571,85 @@ These are intended for Helm, Ivy, etc." ('moderate (list :inherit (list subtleface bold))) (_ (list :inherit (list intenseface bold))))) -(defun modus-themes--link (fg fgfaint underline) +(defun modus-themes--link (fg fgfaint underline bg bgneutral) "Conditional application of link styles. FG is the link's default color for its text and underline property. FGFAINT is a desaturated color for the text and -underline. UNDERLINE is a gray color only for the undeline." - (pcase modus-themes-links - ('faint (list :foreground fgfaint :underline t)) - ('neutral-underline (list :foreground fg :underline underline)) - ('faint-neutral-underline (list :foreground fgfaint :underline underline)) - ('no-underline (list :foreground fg :underline nil)) - ('underline-only (list :underline t)) - ('neutral-underline-only (list :underline underline)) - (_ (list :foreground fg :underline t)))) +underline. UNDERLINE is a gray color only for the undeline. BG +is a background color and BGNEUTRAL is its fallback value." + (let ((modus-themes-links + (if (listp modus-themes-links) + modus-themes-links + ;; translation layer for legacy values + (pcase modus-themes-links + ('faint '(faint)) + ('neutral-underline '(neutral-underline)) + ('faint-neutral-underline '(neutral-underline faint)) + ('no-underline '(no-underline)) + ('underline-only '(no-color)) + ('neutral-underline-only '(no-color neutral-underline)))))) + (list :inherit + (cond + ((and (memq 'bold modus-themes-links) + (memq 'italic modus-themes-links)) + 'bold-italic) + ((memq 'italic modus-themes-links) + 'italic) + ((memq 'bold modus-themes-links) + 'bold) + ('unspecified)) + :background + (cond + ((and (memq 'no-color modus-themes-links) + (memq 'no-underline modus-themes-links)) + bgneutral) + ((memq 'background modus-themes-links) + bg) + ('unspecified)) + :foreground + (cond + ((memq 'no-color modus-themes-links) + 'unspecified) + ((memq 'faint modus-themes-links) + fgfaint) + (fg)) + :underline + (cond + ((memq 'no-underline modus-themes-links) + 'unspecified) + ((memq 'neutral-underline modus-themes-links) + underline) + (t))))) (defun modus-themes--link-color (fg fgfaint &optional neutralfg) "Extends `modus-themes--link'. FG is the main accented foreground. FGFAINT is also accented, yet desaturated. Optional NEUTRALFG is a gray value." - (pcase modus-themes-links - ('faint (list :foreground fgfaint)) - ('faint-neutral-underline (list :foreground fgfaint)) - ('underline-only (list :underline t :foreground (or neutralfg 'unspecified))) - ('neutral-underline-only (list :underline 'unspecified :foreground (or neutralfg 'unspecified))) - (_ (list :foreground fg)))) + (let ((modus-themes-links + (if (listp modus-themes-links) + modus-themes-links + ;; translation layer for legacy values + (pcase modus-themes-links + ('faint '(faint)) + ('neutral-underline '(neutral-underline)) + ('faint-neutral-underline '(neutral-underline faint)) + ('no-underline '(no-underline)) + ('underline-only '(no-color)) + ('neutral-underline-only '(no-color neutral-underline)))))) + (list :foreground + (cond + ((memq 'no-color modus-themes-links) + (or neutralfg 'unspecified)) + ((memq 'faint modus-themes-links) + fgfaint) + (fg)) + :underline + (cond + ((memq 'no-underline modus-themes-links) + 'unspecified) + ((memq 'neutral-underline modus-themes-links) + (or neutralfg 'unspecified)) + (t))))) (defun modus-themes--scale (amount) "Scale heading by AMOUNT. @@ -2898,39 +3657,96 @@ AMOUNT is a customization option." (when modus-themes-scale-headings (list :height amount))) -(defun modus-themes--region (bg fg bgsubtle bgaccent) +(defun modus-themes--region (bg fg bgsubtle bgaccent bgaccentsubtle) "Apply `modus-themes-region' styles. BG and FG are the main values that are used by default. BGSUBTLE is a subtle background value that can be combined with all colors used to fontify text and code syntax. BGACCENT is a colored -background that combines well with FG." - (pcase modus-themes-region - ('bg-only (list :background bgsubtle)) - ('bg-only-no-extend (list :background bgsubtle :extend nil)) - ('no-extend (list :background bg :foreground fg :extend nil)) - ('accent (list :background bgaccent :foreground fg)) - ('accent-no-extend (list :background bgaccent :foreground fg :extend nil)) - (_ (list :background bg :foreground fg)))) - -(defun modus-themes--hl-line (bgdefault bgintense bgaccent bgaccentul lineneutral lineaccent) +background that combines well with FG. BGACCENTSUBTLE can be +combined with all colors used to fontify text." + (let ((modus-themes-region + (if (listp modus-themes-region) + modus-themes-region + ;; translation layer for legacy values + (pcase modus-themes-region + ('bg-only '(bg-only)) + ('bg-only-no-extend '(bg-only no-extend)) + ('accent '(accented)) + ('accent-no-extend '(accented no-extend)) + ('no-extend '(no-extend)))))) + (list :background + (cond + ((and (memq 'accented modus-themes-region) + (memq 'bg-only modus-themes-region)) + bgaccentsubtle) + ((memq 'accented modus-themes-region) + bgaccent) + ((memq 'bg-only modus-themes-region) + bgsubtle) + (bg)) + :foreground + (cond + ((and (memq 'accented modus-themes-region) + (memq 'bg-only modus-themes-region)) + 'unspecified) + ((memq 'bg-only modus-themes-region) + 'unspecified) + (fg)) + :extend + (cond + ((memq 'no-extend modus-themes-region) + nil) + (t))))) + +(defun modus-themes--hl-line + (bgdefault bgintense bgaccent bgaccentsubtle lineneutral lineaccent lineneutralintense lineaccentintense) "Apply `modus-themes-hl-line' styles. BGDEFAULT is a subtle neutral background. BGINTENSE is like the default, but more prominent. BGACCENT is a prominent accented -background, while BGACCENTUL is more subtle and is meant to be -used in tandem with an underline. LINENEUTRAL and LINEACCENT are -a color values that can remain distinct against the buffer's -possible backgrounds: the former is neutral, the latter is -accented." - (pcase modus-themes-hl-line - ('intense-background (list :background bgintense)) - ('accented-background (list :background bgaccent)) - ('underline-neutral (list :background bgdefault :underline lineneutral)) - ('underline-accented (list :background bgaccentul :underline lineaccent)) - ('underline-only-neutral (list :background 'unspecified :underline lineneutral)) - ('underline-only-accented (list :background 'unspecified :underline lineaccent)) - (_ (list :background bgdefault)))) +background, while BGACCENTSUBTLE is more subtle. LINENEUTRAL and +LINEACCENT are color values that can remain distinct against the +buffer's possible backgrounds: the former is neutral, the latter +is accented. LINENEUTRALINTENSE and LINEACCENTINTENSE are their +more prominent alternatives." + (let ((modus-themes-hl-line + (if (listp modus-themes-hl-line) + modus-themes-hl-line + ;; translation layer for legacy values + (pcase modus-themes-hl-line + ('intense-background '(intense)) + ('accented-background '(accented)) + ('underline-neutral '(underline)) + ('underline-accented '(underline accented)) + ('underline-only-neutral '(underline)) ; only underline styles have been removed + ('underline-only-accented '(underline accented)))))) + (list :background + (cond + ((and (memq 'intense modus-themes-hl-line) + (memq 'accented modus-themes-hl-line)) + bgaccent) + ((memq 'accented modus-themes-hl-line) + bgaccentsubtle) + ((memq 'intense modus-themes-hl-line) + bgintense) + (bgdefault)) + :underline + (cond + ((and (memq 'intense modus-themes-hl-line) + (memq 'accented modus-themes-hl-line) + (memq 'underline modus-themes-hl-line)) + lineaccentintense) + ((and (memq 'accented modus-themes-hl-line) + (memq 'underline modus-themes-hl-line)) + lineaccent) + ((and (memq 'intense modus-themes-hl-line) + (memq 'underline modus-themes-hl-line)) + lineneutralintense) + ((or (memq 'no-background modus-themes-hl-line) + (memq 'underline modus-themes-hl-line)) + lineneutral) + ('unspecified))))) (defun modus-themes--mail-cite (mainfg subtlefg) "Combinations for `modus-themes-mail-citations'. @@ -3226,32 +4042,40 @@ by virtue of calling either of `modus-themes-load-operandi' and ;; styles for regular headings used in Org, Markdown, Info, etc. `(modus-themes-heading-1 ((,class ,@(modus-themes--heading - 1 fg-main magenta-alt-other magenta-nuanced-bg bg-region) + 1 fg-main magenta-alt-other + magenta-nuanced-bg bg-alt bg-region) ,@(modus-themes--scale modus-themes-scale-4)))) `(modus-themes-heading-2 ((,class ,@(modus-themes--heading - 2 fg-special-warm magenta-alt red-nuanced-bg bg-region) + 2 fg-special-warm magenta-alt + red-nuanced-bg bg-alt bg-region) ,@(modus-themes--scale modus-themes-scale-3)))) `(modus-themes-heading-3 ((,class ,@(modus-themes--heading - 3 fg-special-cold blue blue-nuanced-bg bg-region) + 3 fg-special-cold blue + blue-nuanced-bg bg-alt bg-region) ,@(modus-themes--scale modus-themes-scale-2)))) `(modus-themes-heading-4 ((,class ,@(modus-themes--heading - 4 fg-special-mild cyan cyan-nuanced-bg bg-region) + 4 fg-special-mild cyan + cyan-nuanced-bg bg-alt bg-region) ,@(modus-themes--scale modus-themes-scale-1)))) `(modus-themes-heading-5 ((,class ,@(modus-themes--heading - 5 fg-special-calm green-alt-other green-nuanced-bg bg-region)))) + 5 fg-special-calm green-alt-other + green-nuanced-bg bg-alt bg-region)))) `(modus-themes-heading-6 ((,class ,@(modus-themes--heading - 6 yellow-nuanced-fg yellow-alt-other yellow-nuanced-bg bg-region)))) + 6 yellow-nuanced-fg yellow-alt-other + yellow-nuanced-bg bg-alt bg-region)))) `(modus-themes-heading-7 ((,class ,@(modus-themes--heading - 7 red-nuanced-fg red-alt red-nuanced-bg bg-region)))) + 7 red-nuanced-fg red-alt + red-nuanced-bg bg-alt bg-region)))) `(modus-themes-heading-8 ((,class ,@(modus-themes--heading - 8 magenta-nuanced-fg magenta bg-alt bg-region)))) + 8 magenta-nuanced-fg magenta + bg-alt bg-alt bg-region)))) ;;;;; graph-specific faces `(modus-themes-graph-red-0 ((,class :background ,red-graph-0-bg))) `(modus-themes-graph-red-1 ((,class :background ,red-graph-1-bg))) @@ -3267,25 +4091,27 @@ by virtue of calling either of `modus-themes-load-operandi' and `(modus-themes-graph-cyan-1 ((,class :background ,cyan-graph-1-bg))) ;;;;; language checkers `(modus-themes-lang-error ((,class ,@(modus-themes--lang-check - fg-lang-underline-error - fg-lang-error - red red-nuanced-bg)))) + fg-lang-underline-error fg-lang-error + red red-refine-fg red-nuanced-bg red-refine-bg)))) `(modus-themes-lang-note ((,class ,@(modus-themes--lang-check - fg-lang-underline-note - fg-lang-note - blue-alt blue-nuanced-bg)))) + fg-lang-underline-note fg-lang-note + blue-alt blue-refine-fg blue-nuanced-bg blue-refine-bg)))) `(modus-themes-lang-warning ((,class ,@(modus-themes--lang-check - fg-lang-underline-warning - fg-lang-warning - yellow yellow-nuanced-bg)))) + fg-lang-underline-warning fg-lang-warning + yellow yellow-refine-fg yellow-nuanced-bg yellow-refine-bg)))) ;;;;; other custom faces `(modus-themes-bold ((,class ,@(modus-themes--bold-weight)))) `(modus-themes-hl-line ((,class ,@(modus-themes--hl-line bg-hl-line bg-hl-line-intense bg-hl-line-intense-accent blue-nuanced-bg - bg-region blue-intense-bg) + bg-region blue-intense-bg + fg-alt cyan-intense) :extend t))) `(modus-themes-key-binding ((,class :inherit bold :foreground ,blue-alt-other))) + `(modus-themes-prompt ((,class ,@(modus-themes--prompt + cyan-alt-other blue-alt-other fg-alt + cyan-nuanced-bg blue-refine-bg fg-main + bg-alt bg-active)))) `(modus-themes-reset-hard ((,class :inherit (fixed-pitch modus-themes-reset-soft)))) `(modus-themes-reset-soft ((,class :background ,bg-main :foreground ,fg-main :weight normal :slant normal :strike-through nil @@ -3301,6 +4127,7 @@ by virtue of calling either of `modus-themes-load-operandi' and green-active)))) `(modus-themes-slant ((,class :inherit italic :slant ,@(modus-themes--slant)))) `(modus-themes-variable-pitch ((,class ,@(modus-themes--variable-pitch)))) + `(modus-themes-fixed-pitch ((,class ,@(modus-themes--fixed-pitch)))) ;;;; standard faces ;;;;; absolute essentials `(default ((,class :background ,bg-main :foreground ,fg-main))) @@ -3313,11 +4140,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(bold-italic ((,class :inherit (bold italic)))) `(buffer-menu-buffer ((,class :inherit bold))) `(comint-highlight-input ((,class :inherit bold))) - `(comint-highlight-prompt ((,class :inherit modus-themes-bold - ,@(modus-themes--prompt - cyan - blue-nuanced-bg blue-alt - blue-refine-bg fg-main)))) + `(comint-highlight-prompt ((,class :inherit modus-themes-prompt))) `(error ((,class :inherit bold :foreground ,red))) `(escape-glyph ((,class :foreground ,fg-escape-char-construct))) `(file-name-shadow ((,class :foreground ,fg-unfocused))) @@ -3332,15 +4155,14 @@ by virtue of calling either of `modus-themes-load-operandi' and `(italic ((,class :slant italic))) `(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct))) `(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline t))) - `(minibuffer-prompt ((,class ,@(modus-themes--prompt - cyan-alt-other - cyan-nuanced-bg cyan - cyan-refine-bg fg-main)))) + `(minibuffer-prompt ((,class :inherit modus-themes-prompt))) `(mm-command-output ((,class :foreground ,red-alt-other))) `(mm-uu-extract ((,class :background ,bg-dim :foreground ,fg-special-mild))) - `(next-error ((,class :inherit modus-themes-subtle-red))) + `(next-error ((,class :inherit modus-themes-subtle-red :extend t))) `(rectangle-preview ((,class :inherit modus-themes-special-mild))) - `(region ((,class ,@(modus-themes--region bg-region fg-main bg-hl-alt-intense bg-region-accent)))) + `(region ((,class ,@(modus-themes--region bg-region fg-main + bg-hl-alt-intense bg-region-accent + bg-region-accent-subtle)))) `(secondary-selection ((,class :inherit modus-themes-special-cold))) `(shadow ((,class :foreground ,fg-alt))) `(success ((,class :inherit bold :foreground ,@(modus-themes--success-deuteran blue green)))) @@ -3348,7 +4170,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(warning ((,class :inherit bold :foreground ,yellow))) ;;;;; buttons, links, widgets `(button ((,class ,@(modus-themes--link - blue-alt-other blue-alt-other-faint bg-region)))) + blue-alt-other blue-alt-other-faint + bg-region blue-nuanced-bg bg-alt)))) `(link ((,class :inherit button))) `(link-visited ((,class :inherit button ,@(modus-themes--link-color @@ -3358,7 +4181,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(widget-button-pressed ((,class :inherit widget-button :foreground ,magenta))) `(widget-documentation ((,class :foreground ,green))) `(widget-field ((,class :background ,bg-alt :foreground ,fg-dim))) - `(widget-inactive ((,class :background ,bg-inactive :foreground ,fg-inactive))) + `(widget-inactive ((,class :foreground ,fg-alt))) `(widget-single-line-field ((,class :inherit widget-field))) ;;;;; ag `(ag-hit-face ((,class :foreground ,fg-special-cold))) @@ -3419,21 +4242,24 @@ by virtue of calling either of `modus-themes-load-operandi' and `(anzu-replace-highlight ((,class :inherit modus-themes-refine-yellow :underline t))) `(anzu-replace-to ((,class :inherit (modus-themes-search-success bold)))) ;;;;; apropos + `(apropos-button ((,class :inherit button + ,@(modus-themes--link-color + magenta-alt-other magenta-alt-other-faint)))) `(apropos-function-button ((,class :inherit button ,@(modus-themes--link-color - magenta-alt-other magenta-alt-other-faint)))) + magenta magenta-faint)))) `(apropos-keybinding ((,class :inherit modus-themes-key-binding))) `(apropos-misc-button ((,class :inherit button ,@(modus-themes--link-color cyan-alt-other cyan-alt-other-faint)))) `(apropos-property ((,class :inherit modus-themes-bold :foreground ,magenta-alt))) - `(apropos-symbol ((,class :inherit modus-themes-bold :foreground ,magenta))) + `(apropos-symbol ((,class :inherit modus-themes-pseudo-header))) `(apropos-user-option-button ((,class :inherit button ,@(modus-themes--link-color - green-alt-other green-alt-other-faint)))) + cyan cyan-faint)))) `(apropos-variable-button ((,class :inherit button ,@(modus-themes--link-color - blue blue-faint)))) + blue-alt blue-alt-faint)))) ;;;;; apt-sources-list `(apt-sources-list-components ((,class :foreground ,cyan))) `(apt-sources-list-options ((,class :foreground ,yellow))) @@ -3546,7 +4372,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(calendar-month-header ((,class :inherit modus-themes-pseudo-header))) `(calendar-today ((,class :inherit bold :underline t))) `(calendar-weekday-header ((,class :foreground ,fg-unfocused))) - `(calendar-weekend-header ((,class :foreground ,fg-unfocused))) + `(calendar-weekend-header ((,class :foreground ,red-faint))) `(diary ((,class :background ,blue-nuanced-bg :foreground ,blue-alt-other))) `(diary-anniversary ((,class :foreground ,red-alt-other))) `(diary-time ((,class :foreground ,cyan))) @@ -3566,7 +4392,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(cfw:face-sunday ((,class :inherit bold :foreground ,cyan-alt-other))) `(cfw:face-title ((,class :inherit modus-themes-variable-pitch :foreground ,fg-special-cold - ,@(modus-themes--scale modus-themes-scale-5)))) + ,@(modus-themes--scale modus-themes-scale-title)))) `(cfw:face-today ((,class :background ,bg-inactive))) `(cfw:face-today-title ((,class :background ,bg-active))) `(cfw:face-toolbar ((,class :background ,bg-alt :foreground ,bg-alt))) @@ -3618,7 +4444,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(cider-instrumented-face ((,class :box (:line-width -1 :color ,red :style nil) :background ,bg-dim))) `(cider-reader-conditional-face ((,class :inherit italic :foreground ,fg-special-warm))) `(cider-repl-input-face ((,class :inherit bold))) - `(cider-repl-prompt-face ((,class :inherit comint-highlight-prompt))) + `(cider-repl-prompt-face ((,class :inherit modus-themes-prompt))) `(cider-repl-stderr-face ((,class :inherit bold :foreground ,red))) `(cider-repl-stdout-face ((,class :foreground ,blue))) `(cider-result-overlay-face ((,class :box (:line-width -1 :color ,blue :style nil) :background ,bg-dim))) @@ -3642,7 +4468,7 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; circe (and lui) `(circe-fool-face ((,class :inherit shadow))) `(circe-highlight-nick-face ((,class :inherit bold :foreground ,blue))) - `(circe-prompt-face ((,class :inherit comint-highlight-prompt))) + `(circe-prompt-face ((,class :inherit modus-themes-prompt))) `(circe-server-face ((,class :foreground ,fg-unfocused))) `(lui-button-face ((,class :inherit button))) `(lui-highlight-face ((,class :foreground ,magenta-alt))) @@ -3755,6 +4581,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(cperl-nonoverridable-face ((,class :foreground unspecified))) `(cperl-array-face ((,class :inherit font-lock-keyword-face))) `(cperl-hash-face ((,class :inherit font-lock-variable-name-face))) +;;;;; css-mode + `(css-property ((,class :inherit font-lock-type-face))) + `(css-selector ((,class :inherit font-lock-keyword-face))) ;;;;; csv-mode `(csv-separator-face ((,class :foreground ,red-intense))) ;;;;; ctrlf @@ -3851,7 +4680,7 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; diff-mode `(diff-added ((,class :inherit modus-themes-diff-added))) `(diff-changed ((,class :inherit modus-themes-diff-changed :extend t))) - `(diff-context ((,class :foreground ,fg-alt))) + `(diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list :foreground fg-unfocused))))) `(diff-error ((,class :inherit modus-themes-intense-red))) `(diff-file-header ((,class :inherit (bold diff-header)))) `(diff-function ((,class :inherit modus-themes-diff-heading))) @@ -4113,8 +4942,10 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; embark `(embark-keybinding ((,class :inherit modus-themes-key-binding))) ;;;;; emms - `(emms-playlist-track-face ((,class :foreground ,blue))) - `(emms-playlist-selected-face ((,class :inherit bold :foreground ,magenta))) + `(emms-playlist-track-face ((,class :foreground ,blue-alt))) + `(emms-playlist-selected-face ((,class :inherit bold :foreground ,blue-alt-other))) + `(emms-metaplaylist-mode-current-face ((,class :inherit emms-playlist-selected-face))) + `(emms-metaplaylist-mode-face ((,class :foreground ,cyan))) ;;;;; enh-ruby-mode (enhanced-ruby-mode) `(enh-ruby-heredoc-delimiter-face ((,class :inherit font-lock-constant-face))) `(enh-ruby-op-face ((,class :foreground ,fg-main))) @@ -4162,7 +4993,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(erc-nick-prefix-face ((,class :inherit erc-nick-default-face))) `(erc-notice-face ((,class :foreground ,fg-unfocused))) `(erc-pal-face ((,class :inherit bold :foreground ,red-alt))) - `(erc-prompt-face ((,class :inherit comint-highlight-prompt))) + `(erc-prompt-face ((,class :inherit modus-themes-prompt))) `(erc-timestamp-face ((,class :foreground ,blue-nuanced-fg))) `(erc-underline-face ((,class :underline t))) `(bg:erc-color-face0 ((,class :background "white"))) @@ -4215,7 +5046,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(eshell-ls-special ((,class :foreground ,magenta))) `(eshell-ls-symlink ((,class :foreground ,cyan))) `(eshell-ls-unreadable ((,class :background ,bg-inactive :foreground ,fg-inactive))) - `(eshell-prompt ((,class :inherit comint-highlight-prompt))) + `(eshell-prompt ((,class :inherit modus-themes-prompt))) ;;;;; eshell-fringe-status `(eshell-fringe-status-failure ((,class :inherit error))) `(eshell-fringe-status-success ((,class :inherit success))) @@ -4363,45 +5194,56 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; font-lock `(font-lock-builtin-face ((,class :inherit modus-themes-bold ,@(modus-themes--syntax-extra - magenta-alt magenta-alt-faint blue-alt)))) + magenta-alt magenta-alt-faint + magenta magenta-faint)))) `(font-lock-comment-delimiter-face ((,class :inherit font-lock-comment-face))) `(font-lock-comment-face ((,class :inherit modus-themes-slant ,@(modus-themes--syntax-comment - fg-alt fg-comment-yellow)))) + fg-alt fg-comment-yellow yellow-alt-other-faint)))) `(font-lock-constant-face ((,class ,@(modus-themes--syntax-extra - blue-alt-other blue-alt-other-faint magenta-alt-other)))) + blue-alt-other blue-alt-other-faint + magenta-alt-other magenta-alt-other-faint)))) `(font-lock-doc-face ((,class :inherit modus-themes-slant - ,@(modus-themes--syntax-docstring - fg-docstring green-alt-other-faint - green-alt-other-faint magenta-nuanced-fg)))) + ,@(modus-themes--syntax-string + fg-docstring fg-special-cold + fg-special-mild magenta-nuanced-fg + fg-special-mild magenta-nuanced-fg)))) `(font-lock-function-name-face ((,class ,@(modus-themes--syntax-extra - magenta magenta-faint magenta-alt)))) + magenta magenta-faint + magenta-alt magenta-alt-faint)))) `(font-lock-keyword-face ((,class :inherit modus-themes-bold ,@(modus-themes--syntax-extra - magenta-alt-other magenta-alt-other-faint cyan-alt-other)))) + magenta-alt-other magenta-alt-other-faint + cyan cyan-faint)))) `(font-lock-negation-char-face ((,class :inherit modus-themes-bold ,@(modus-themes--syntax-foreground yellow yellow-faint)))) - `(font-lock-preprocessor-face ((,class ,@(modus-themes--syntax-foreground - red-alt-other red-alt-other-faint)))) + `(font-lock-preprocessor-face ((,class ,@(modus-themes--syntax-extra + red-alt-other red-alt-other-faint + blue-alt blue-alt-faint)))) `(font-lock-regexp-grouping-backslash ((,class :inherit bold ,@(modus-themes--syntax-string fg-escape-char-backslash yellow-alt-faint - magenta-alt-other blue-alt)))) + yellow magenta-alt + yellow-faint red-faint)))) `(font-lock-regexp-grouping-construct ((,class :inherit bold ,@(modus-themes--syntax-string fg-escape-char-construct red-alt-other-faint - red magenta-alt)))) + blue blue-alt-other + blue-faint blue-alt-other-faint)))) `(font-lock-string-face ((,class ,@(modus-themes--syntax-string - blue-alt blue-alt-faint green green-alt)))) + blue-alt blue-alt-faint + green red + green-faint red-faint)))) `(font-lock-type-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-extra - cyan-alt-other cyan-alt-faint cyan-alt)))) + ,@(modus-themes--syntax-foreground + cyan-alt-other cyan-alt-faint)))) `(font-lock-variable-name-face ((,class ,@(modus-themes--syntax-extra - cyan cyan-faint blue-alt-faint)))) + cyan cyan-faint + blue-alt-other blue-alt-other-faint)))) `(font-lock-warning-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-foreground - yellow-active yellow-alt-faint)))) + ,@(modus-themes--syntax-comment + yellow-active red-active red-faint yellow-faint)))) ;;;;; forge `(forge-post-author ((,class :inherit bold :foreground ,fg-main))) `(forge-post-date ((,class :foreground ,fg-special-cold))) @@ -4439,7 +5281,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(geiser-font-lock-image-button ((,class :inherit button :foreground ,green-alt))) `(geiser-font-lock-repl-input ((,class :inherit bold))) `(geiser-font-lock-repl-output ((,class :inherit font-lock-keyword-face))) - `(geiser-font-lock-repl-prompt ((,class :inherit minibuffer-prompt))) + `(geiser-font-lock-repl-prompt ((,class :inherit modus-themes-prompt))) `(geiser-font-lock-xref-header ((,class :inherit bold))) `(geiser-font-lock-xref-link ((,class :inherit button))) ;;;;; git-commit @@ -4580,7 +5422,13 @@ by virtue of calling either of `modus-themes-load-operandi' and `(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other))) `(gnus-summary-normal-undownloaded ((,class :foreground ,yellow))) `(gnus-summary-normal-unread ((,class :foreground ,fg-main))) - `(gnus-summary-selected ((,class :inherit modus-themes-subtle-blue :extend t))) + `(gnus-summary-selected ((,class :inherit highlight :extend t))) +;;;;; gotest + `(go-test--ok-face ((,class :inherit success))) + `(go-test--error-face ((,class :inherit error))) + `(go-test--warning-face ((,class :inherit warning))) + `(go-test--pointer-face ((,class :foreground ,magenta-alt-other))) + `(go-test--standard-face ((,class :foreground ,fg-special-cold))) ;;;;; golden-ratio-scroll-screen `(golden-ratio-scroll-highlight-line-face ((,class :background ,cyan-subtle-bg :foreground ,fg-main))) ;;;;; helm @@ -4681,7 +5529,7 @@ by virtue of calling either of `modus-themes-load-operandi' and 'modus-themes-subtle-cyan 'modus-themes-nuanced-cyan cyan-alt-other)))) - `(helm-minibuffer-prompt ((,class :inherit minibuffer-prompt))) + `(helm-minibuffer-prompt ((,class :inherit modus-themes-prompt))) `(helm-moccur-buffer ((,class :inherit button ,@(modus-themes--link-color cyan-alt-other cyan-alt-other-faint)))) @@ -4748,7 +5596,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(hi-red-b ((,class :inherit bold :background ,red-intense-bg :foreground ,fg-main))) `(hi-salmon ((,class :background ,red-subtle-bg :foreground ,fg-main))) `(hi-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-main))) - `(highlight ((,class :inherit modus-themes-subtle-blue))) + `(highlight ((,class :background ,blue-subtle-bg :foreground ,fg-main))) `(highlight-changes ((,class :foreground ,red-alt :underline nil))) `(highlight-changes-delete ((,class :background ,red-nuanced-bg :foreground ,red :underline t))) @@ -4791,11 +5639,11 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; hl-todo `(hl-todo ((,class :inherit (bold modus-themes-slant) :foreground ,red-alt-other))) ;;;;; hydra - `(hydra-face-amaranth ((,class :inherit bold :foreground ,yellow))) - `(hydra-face-blue ((,class :inherit bold :foreground ,blue-alt))) - `(hydra-face-pink ((,class :inherit bold :foreground ,magenta-alt))) - `(hydra-face-red ((,class :inherit bold :foreground ,red))) - `(hydra-face-teal ((,class :inherit bold :foreground ,cyan))) + `(hydra-face-amaranth ((,class :inherit bold :foreground ,yellow-alt))) + `(hydra-face-blue ((,class :inherit bold :foreground ,blue))) + `(hydra-face-pink ((,class :inherit bold :foreground ,magenta-alt-faint))) + `(hydra-face-red ((,class :inherit bold :foreground ,red-faint))) + `(hydra-face-teal ((,class :inherit bold :foreground ,cyan-alt-other))) ;;;;; hyperlist `(hyperlist-condition ((,class :foreground ,green))) `(hyperlist-hashtag ((,class :foreground ,yellow))) @@ -4847,10 +5695,10 @@ by virtue of calling either of `modus-themes-load-operandi' and `(indium-keyword-face ((,class :inherit font-lock-keyword-face))) `(indium-litable-face ((,class :inherit modus-themes-slant :foreground ,fg-special-warm))) `(indium-repl-error-face ((,class :inherit error))) - `(indium-repl-prompt-face ((,class :inherit comint-highlight-prompt))) + `(indium-repl-prompt-face ((,class :inherit modus-themes-prompt))) `(indium-repl-stdout-face ((,class :foreground ,fg-main))) ;;;;; info - `(Info-quoted ((,class ,@(modus-themes--mixed-fonts) ; the capitalization is canonical + `(Info-quoted ((,class :inherit modus-themes-fixed-pitch ; the capitalization is canonical :background ,bg-alt :foreground ,fg-special-calm))) `(info-header-node ((,class :inherit bold :foreground ,fg-alt))) `(info-header-xref ((,class :foreground ,blue-active))) @@ -5016,6 +5864,17 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; keycast `(keycast-command ((,class :inherit bold :foreground ,blue-active))) `(keycast-key ((,class :background ,blue-active :foreground ,bg-main))) +;;;;; ledger-mode + `(ledger-font-auto-xact-face ((,class :foreground ,magenta))) + `(ledger-font-account-name-face ((,class :foreground ,fg-special-cold))) + `(ledger-font-directive-face ((,class :foreground ,magenta-alt-other))) + `(ledger-font-posting-date-face ((,class :inherit bold :foreground ,fg-main))) + `(ledger-font-periodic-xact-face ((,class :foreground ,cyan-alt-other))) + `(ledger-font-posting-amount-face ((,class :foreground ,fg-special-mild))) + `(ledger-font-payee-cleared-face ((,class :foreground ,blue-alt))) + `(ledger-font-payee-pending-face ((,class :foreground ,yellow))) + `(ledger-font-payee-uncleared-face ((,class :foreground ,red-alt-other))) + `(ledger-font-xact-highlight-face ((,class :background ,bg-hl-alt))) ;;;;; line numbers (display-line-numbers-mode and global variant) `(line-number ((,class :inherit default @@ -5119,7 +5978,7 @@ by virtue of calling either of `modus-themes-load-operandi' and bg-diff-changed fg-diff-changed yellow-nuanced-bg fg-diff-changed)))) `(magit-diff-base-highlight ((,class :inherit modus-themes-diff-focus-changed))) - `(magit-diff-context ((,class :foreground ,fg-unfocused))) + `(magit-diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list :foreground fg-unfocused))))) `(magit-diff-context-highlight ((,class ,@(modus-themes--diff bg-dim fg-dim bg-inactive fg-inactive @@ -5239,7 +6098,7 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; markdown-mode `(markdown-blockquote-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold))) `(markdown-bold-face ((,class :inherit bold))) - `(markdown-code-face ((,class ,@(modus-themes--mixed-fonts) :background ,bg-dim :extend t))) + `(markdown-code-face ((,class :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t))) `(markdown-comment-face ((,class :inherit font-lock-comment-face))) `(markdown-footnote-marker-face ((,class :inherit bold :foreground ,cyan-alt))) `(markdown-footnote-text-face ((,class :inherit modus-themes-slant :foreground ,fg-main))) @@ -5254,22 +6113,22 @@ by virtue of calling either of `modus-themes-load-operandi' and `(markdown-header-face-6 ((,class :inherit modus-themes-heading-6))) `(markdown-header-rule-face ((,class :inherit bold :foreground ,fg-special-warm))) `(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm))) - `(markdown-html-attr-name-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-html-attr-name-face ((,class :inherit modus-themes-fixed-pitch :foreground ,cyan))) - `(markdown-html-attr-value-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-html-attr-value-face ((,class :inherit modus-themes-fixed-pitch :foreground ,blue))) - `(markdown-html-entity-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-html-entity-face ((,class :inherit modus-themes-fixed-pitch :foreground ,cyan))) - `(markdown-html-tag-delimiter-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-html-tag-delimiter-face ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-mild))) - `(markdown-html-tag-name-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-html-tag-name-face ((,class :inherit modus-themes-fixed-pitch :foreground ,magenta-alt))) - `(markdown-inline-code-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-inline-code-face ((,class :inherit modus-themes-fixed-pitch :background ,bg-alt :foreground ,fg-special-calm))) `(markdown-italic-face ((,class :inherit italic :foreground ,fg-special-cold))) - `(markdown-language-info-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-language-info-face ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold))) - `(markdown-language-keyword-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-language-keyword-face ((,class :inherit modus-themes-fixed-pitch :background ,bg-alt :foreground ,fg-alt))) `(markdown-line-break-face ((,class :inherit modus-themes-refine-cyan :underline t))) @@ -5285,46 +6144,53 @@ by virtue of calling either of `modus-themes-load-operandi' and `(markdown-pre-face ((,class :inherit markdown-code-face :foreground ,fg-special-mild))) `(markdown-reference-face ((,class :inherit markdown-markup-face))) `(markdown-strike-through-face ((,class :strike-through t))) - `(markdown-table-face ((,class ,@(modus-themes--mixed-fonts) + `(markdown-table-face ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold))) `(markdown-url-face ((,class :foreground ,blue-alt))) ;;;;; markup-faces (`adoc-mode') - `(markup-anchor-face ((,class :foreground ,fg-inactive))) - `(markup-attribute-face ((,class :inherit italic :foreground ,fg-inactive))) - `(markup-big-face ((,class :height 1.3 :foreground ,blue-nuanced-fg))) + `(markup-attribute-face ((,class :inherit (italic markup-meta-face)))) `(markup-bold-face ((,class :inherit bold :foreground ,red-nuanced-fg))) - `(markup-code-face ((,class :inherit fixed-pitch :foreground ,magenta))) - `(markup-command-face ((,class :foreground ,fg-inactive))) + `(markup-code-face ((,class :foreground ,magenta))) `(markup-comment-face ((,class :inherit font-lock-comment-face))) - `(markup-complex-replacement-face ((,class :box (:line-width 2 :color nil :style released-button) - :inherit modus-themes-refine-magenta))) - `(markup-emphasis-face ((,class :inherit italic :foreground ,fg-special-cold))) - `(markup-error-face ((,class :inherit bold :foreground ,red))) + `(markup-complex-replacement-face ((,class :background ,magenta-nuanced-bg + :foreground ,magenta-alt-other + :underline ,magenta-alt-other))) + `(markup-emphasis-face ((,class :inherit markup-italic-face))) + `(markup-error-face ((,class :inherit error))) `(markup-gen-face ((,class :foreground ,magenta-alt))) - `(markup-internal-reference-face ((,class :inherit button :foreground ,fg-alt))) + `(markup-internal-reference-face ((,class :foreground ,fg-alt :underline ,bg-region))) `(markup-italic-face ((,class :inherit italic :foreground ,fg-special-cold))) - `(markup-list-face ((,class :inherit modus-themes-special-calm))) - `(markup-meta-face ((,class :foreground ,fg-inactive))) - `(markup-meta-hide-face ((,class :inherit shadow))) - `(markup-passthrough-face ((,class :inherit fixed-pitch :foreground ,cyan))) - `(markup-preprocessor-face ((,class :foreground ,red-alt-other))) - `(markup-replacement-face ((,class :foreground ,yellow-alt-other))) - `(markup-secondary-text-face ((,class :height 0.8 :foreground ,magenta-nuanced-fg))) - `(markup-small-face ((,class :height 0.8 :foreground ,fg-main))) - `(markup-strong-face ((,class :inherit bold :foreground ,red-nuanced-fg))) - `(markup-subscript-face ((,class :height 0.8 :foreground ,fg-special-cold))) - `(markup-superscript-face ((,class :height 0.8 :foreground ,fg-special-cold))) - `(markup-table-cell-face ((,class :inherit modus-themes-special-cold))) - `(markup-table-face ((,class :inherit modus-themes-subtle-cyan))) - `(markup-table-row-face ((,class :inherit modus-themes-subtle-cyan))) - `(markup-title-0-face ((,class :height 3.0 :foreground ,blue-nuanced-fg))) - `(markup-title-1-face ((,class :height 2.4 :foreground ,blue-nuanced-fg))) - `(markup-title-2-face ((,class :height 1.8 :foreground ,blue-nuanced-fg))) - `(markup-title-3-face ((,class :height 1.4 :foreground ,blue-nuanced-fg))) - `(markup-title-4-face ((,class :height 1.2 :foreground ,blue-nuanced-fg))) - `(markup-title-5-face ((,class :height 1.2 :foreground ,blue-nuanced-fg :underline t))) - `(markup-value-face ((,class :foreground ,fg-inactive))) - `(markup-verbatim-face ((,class :inherit modus-themes-special-mild))) + `(markup-list-face ((,class :inherit modus-themes-special-cold))) + `(markup-meta-face ((,class :inherit shadow))) + `(markup-meta-hide-face ((,class :foreground "gray50"))) + `(markup-reference-face ((,class :foreground ,blue-alt :underline ,bg-region))) + `(markup-replacement-face ((,class :inherit fixed-pitch :foreground ,red-alt))) + `(markup-secondary-text-face ((,class :height 0.9 :foreground ,cyan-alt-other))) + `(markup-small-face ((,class :inherit markup-gen-face :height 0.9))) + `(markup-strong-face ((,class :inherit markup-bold-face))) + `(markup-subscript-face ((,class :height 0.9 :foreground ,magenta-alt-other))) + `(markup-superscript-face ((,class :height 0.9 :foreground ,magenta-alt-other))) + `(markup-table-cell-face ((,class :inherit modus-themes-subtle-neutral))) + `(markup-table-face ((,class :inherit modus-themes-subtle-neutral))) + `(markup-table-row-face ((,class :inherit modus-themes-special-cold))) + `(markup-title-0-face ((,class :inherit (bold modus-themes-variable-pitch) + :foreground ,blue-nuanced-fg + ,@(modus-themes--scale modus-themes-scale-title)))) + `(markup-title-1-face ((,class :inherit (bold modus-themes-variable-pitch) + :foreground ,blue-nuanced-fg + ,@(modus-themes--scale modus-themes-scale-1)))) + `(markup-title-2-face ((,class :inherit (bold modus-themes-variable-pitch) + :foreground ,blue-nuanced-fg + ,@(modus-themes--scale modus-themes-scale-2)))) + `(markup-title-3-face ((,class :inherit (bold modus-themes-variable-pitch) + :foreground ,blue-nuanced-fg + ,@(modus-themes--scale modus-themes-scale-3)))) + `(markup-title-4-face ((,class :inherit (bold modus-themes-variable-pitch) + :foreground ,blue-nuanced-fg + ,@(modus-themes--scale modus-themes-scale-4)))) + `(markup-title-5-face ((,class :inherit (bold modus-themes-variable-pitch) + :foreground ,blue-nuanced-fg))) + `(markup-verbatim-face ((,class :background ,bg-alt))) ;;;;; mentor `(mentor-download-message ((,class :foreground ,fg-special-warm))) `(mentor-download-name ((,class :foreground ,fg-special-cold))) @@ -5548,39 +6414,41 @@ by virtue of calling either of `modus-themes-load-operandi' and yellow yellow-nuanced-bg yellow-refine-bg yellow-refine-fg)))) ;;;;; org - `(org-agenda-calendar-event ((,class :foreground ,fg-main))) - `(org-agenda-calendar-sexp ((,class :foreground ,cyan-alt))) + `(org-agenda-calendar-event ((,class :inherit shadow))) + `(org-agenda-calendar-sexp ((,class :inherit (modus-themes-slant shadow)))) `(org-agenda-clocking ((,class :inherit modus-themes-special-cold :extend t))) `(org-agenda-column-dateline ((,class :background ,bg-alt))) - `(org-agenda-current-time ((,class :inherit bold :foreground ,blue-alt-other))) - `(org-agenda-date ((,class :foreground ,cyan))) - `(org-agenda-date-today ((,class :inherit bold :foreground ,fg-main :underline t))) - `(org-agenda-date-weekend ((,class :foreground ,cyan-alt-other))) - `(org-agenda-diary ((,class :foreground ,fg-main))) - `(org-agenda-dimmed-todo-face ((,class :inherit bold :foreground ,fg-alt))) - `(org-agenda-done ((,class :foreground ,green-alt))) - `(org-agenda-filter-category ((,class :inherit bold :foreground ,magenta-active))) - `(org-agenda-filter-effort ((,class :inherit bold :foreground ,magenta-active))) - `(org-agenda-filter-regexp ((,class :inherit bold :foreground ,magenta-active))) - `(org-agenda-filter-tags ((,class :inherit bold :foreground ,magenta-active))) + `(org-agenda-current-time ((,class :foreground ,blue-alt-other-faint))) + `(org-agenda-date ((,class ,@(modus-themes--agenda-date cyan fg-main nil)))) + `(org-agenda-date-today ((,class :background ,bg-active + ,@(modus-themes--agenda-date blue-active fg-main t cyan-active)))) + `(org-agenda-date-weekend ((,class ,@(modus-themes--agenda-date cyan-alt-other fg-alt nil cyan fg-main)))) + `(org-agenda-diary ((,class :inherit shadow))) + `(org-agenda-dimmed-todo-face ((,class :inherit shadow))) + `(org-agenda-done ((,class :foreground ,@(modus-themes--success-deuteran + blue-nuanced-fg + green-nuanced-fg)))) + `(org-agenda-filter-category ((,class :inherit bold :foreground ,cyan-active))) + `(org-agenda-filter-effort ((,class :inherit bold :foreground ,cyan-active))) + `(org-agenda-filter-regexp ((,class :inherit bold :foreground ,cyan-active))) + `(org-agenda-filter-tags ((,class :inherit bold :foreground ,cyan-active))) `(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground ,fg-dim))) - `(org-agenda-structure ((,class ,@(modus-themes--scale modus-themes-scale-5) - :foreground ,blue-alt))) + `(org-agenda-structure ((,class ,@(modus-themes--agenda-structure blue-alt)))) `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt))) - `(org-block ((,class ,@(modus-themes--mixed-fonts) + `(org-block ((,class :inherit modus-themes-fixed-pitch ,@(modus-themes--org-block bg-dim fg-main)))) - `(org-block-begin-line ((,class ,@(modus-themes--mixed-fonts) + `(org-block-begin-line ((,class :inherit modus-themes-fixed-pitch ,@(modus-themes--org-block-delim bg-dim fg-special-cold - bg-alt fg-special-mild)))) + bg-alt fg-alt)))) `(org-block-end-line ((,class :inherit org-block-begin-line))) `(org-checkbox ((,class :box (:line-width 1 :color ,bg-active) :background ,bg-inactive :foreground ,fg-active))) `(org-checkbox-statistics-done ((,class :inherit org-done))) `(org-checkbox-statistics-todo ((,class :inherit org-todo))) `(org-clock-overlay ((,class :inherit modus-themes-special-cold))) - `(org-code ((,class ,@(modus-themes--mixed-fonts) - :background ,magenta-nuanced-bg :foreground ,magenta-nuanced-fg))) + `(org-code ((,class :inherit modus-themes-fixed-pitch + :background ,bg-alt :foreground ,fg-special-mild))) `(org-column ((,class :background ,bg-alt))) `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt))) `(org-date ((,class :inherit ,(if modus-themes-no-mixed-fonts @@ -5591,51 +6459,52 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t))) `(org-dispatcher-highlight ((,class :inherit (bold modus-themes-mark-alt)))) `(org-document-info ((,class :foreground ,fg-special-cold))) - `(org-document-info-keyword ((,class ,@(modus-themes--mixed-fonts) - :foreground ,fg-alt))) + `(org-document-info-keyword ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt))) `(org-document-title ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,fg-special-cold - ,@(modus-themes--scale modus-themes-scale-5)))) + ,@(modus-themes--scale modus-themes-scale-title)))) `(org-done ((,class :foreground ,@(modus-themes--success-deuteran blue green)))) - `(org-drawer ((,class ,@(modus-themes--mixed-fonts) - :foreground ,fg-alt))) + `(org-drawer ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt))) `(org-ellipsis (())) ; inherits from the heading's color `(org-footnote ((,class :inherit button ,@(modus-themes--link-color blue-alt blue-alt-faint)))) - `(org-formula ((,class ,@(modus-themes--mixed-fonts) - :foreground ,red-alt))) - `(org-habit-alert-face ((,class ,@(modus-themes--org-habit + `(org-formula ((,class :inherit modus-themes-fixed-pitch :foreground ,red-alt))) + `(org-habit-alert-face ((,class ,@(modus-themes--agenda-habit yellow-graph-0-bg yellow-graph-0-bg yellow-graph-1-bg)))) - `(org-habit-alert-future-face ((,class ,@(modus-themes--org-habit + `(org-habit-alert-future-face ((,class ,@(modus-themes--agenda-habit yellow-graph-1-bg yellow-graph-0-bg yellow-graph-1-bg)))) - `(org-habit-clear-face ((,class ,@(modus-themes--org-habit + `(org-habit-clear-face ((,class ,@(modus-themes--agenda-habit blue-graph-0-bg green-graph-1-bg + blue-graph-1-bg blue-graph-1-bg)))) - `(org-habit-clear-future-face ((,class ,@(modus-themes--org-habit + `(org-habit-clear-future-face ((,class ,@(modus-themes--agenda-habit blue-graph-1-bg green-graph-1-bg + blue-graph-1-bg blue-graph-1-bg)))) - `(org-habit-overdue-face ((,class ,@(modus-themes--org-habit + `(org-habit-overdue-face ((,class ,@(modus-themes--agenda-habit red-graph-0-bg red-graph-0-bg red-graph-1-bg)))) - `(org-habit-overdue-future-face ((,class ,@(modus-themes--org-habit + `(org-habit-overdue-future-face ((,class ,@(modus-themes--agenda-habit red-graph-1-bg red-graph-0-bg red-graph-1-bg)))) - `(org-habit-ready-face ((,class ,@(modus-themes--org-habit + `(org-habit-ready-face ((,class ,@(modus-themes--agenda-habit green-graph-0-bg green-graph-0-bg - green-graph-1-bg)))) - `(org-habit-ready-future-face ((,class ,@(modus-themes--org-habit + green-graph-1-bg + blue-graph-0-bg)))) + `(org-habit-ready-future-face ((,class ,@(modus-themes--agenda-habit green-graph-1-bg green-graph-0-bg - green-graph-1-bg)))) + green-graph-1-bg + blue-graph-0-bg)))) `(org-headline-done ((,class :inherit modus-themes-variable-pitch :foreground ,@(modus-themes--success-deuteran blue-nuanced-fg @@ -5654,23 +6523,20 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-level-8 ((,class :inherit modus-themes-heading-8))) `(org-link ((,class :inherit button))) `(org-list-dt ((,class :inherit bold))) - `(org-macro ((,class ,@(modus-themes--mixed-fonts) + `(org-macro ((,class :inherit modus-themes-fixed-pitch :background ,cyan-nuanced-bg :foreground ,cyan-nuanced-fg))) - `(org-meta-line ((,class ,@(modus-themes--mixed-fonts) :foreground ,fg-alt))) + `(org-meta-line ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt))) `(org-mode-line-clock ((,class :foreground ,fg-main))) - `(org-mode-line-clock-overrun ((,class :inherit modus-themes-active-red))) + `(org-mode-line-clock-overrun ((,class :inherit bold :foreground ,red-active))) `(org-priority ((,class :foreground ,magenta))) - `(org-property-value ((,class ,@(modus-themes--mixed-fonts) - :foreground ,fg-special-cold))) + `(org-property-value ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold))) `(org-quote ((,class ,@(modus-themes--org-block bg-dim fg-special-cold fg-main)))) - `(org-scheduled ((,class :foreground ,magenta-alt))) - `(org-scheduled-previously ((,class :foreground ,yellow-alt-other))) - `(org-scheduled-today ((,class :foreground ,magenta-alt-other))) + `(org-scheduled ((,class ,@(modus-themes--agenda-scheduled yellow-faint fg-special-warm magenta-alt)))) + `(org-scheduled-previously ((,class ,@(modus-themes--agenda-scheduled yellow fg-special-warm yellow-alt-other)))) + `(org-scheduled-today ((,class ,@(modus-themes--agenda-scheduled yellow fg-special-warm magenta-alt-other)))) `(org-sexp-date ((,class :inherit org-date))) - `(org-special-keyword ((,class ,@(modus-themes--mixed-fonts) - :foreground ,fg-alt))) - `(org-table ((,class ,@(modus-themes--mixed-fonts) - :foreground ,fg-special-cold))) + `(org-special-keyword ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt))) + `(org-table ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold))) `(org-table-header ((,class :inherit (fixed-pitch modus-themes-intense-neutral)))) `(org-tag ((,class :foreground ,magenta-nuanced-fg))) `(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced-fg))) @@ -5678,8 +6544,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-time-grid ((,class :foreground ,fg-unfocused))) `(org-todo ((,class :foreground ,red))) `(org-upcoming-deadline ((,class :foreground ,red-alt-other))) - `(org-upcoming-distant-deadline ((,class :foreground ,red-nuanced-fg))) - `(org-verbatim ((,class ,@(modus-themes--mixed-fonts) + `(org-upcoming-distant-deadline ((,class :foreground ,red-faint))) + `(org-verbatim ((,class :inherit modus-themes-fixed-pitch :background ,bg-alt :foreground ,fg-special-calm))) `(org-verse ((,class :inherit org-quote))) `(org-warning ((,class :inherit bold :foreground ,red-alt-other))) @@ -5719,7 +6585,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-tree-slide-header-overlay-face ((,class :inherit (bold modus-themes-variable-pitch) :background ,bg-main :foreground ,fg-special-cold :overline nil - ,@(modus-themes--scale modus-themes-scale-5)))) + ,@(modus-themes--scale modus-themes-scale-title)))) ;;;;; org-treescope `(org-treescope-faces--markerinternal-midday ((,class :inherit modus-themes-intense-blue))) `(org-treescope-faces--markerinternal-range ((,class :inherit modus-themes-special-mild))) @@ -5736,7 +6602,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(outline-7 ((,class :inherit modus-themes-heading-7))) `(outline-8 ((,class :inherit modus-themes-heading-8))) ;;;;; outline-minor-faces - `(outline-minor-0 ((,class :background ,bg-alt))) + `(outline-minor-0 (())) ;;;;; package (M-x list-packages) `(package-description ((,class :foreground ,fg-special-cold))) `(package-help-section-name ((,class :inherit bold :foreground ,magenta-alt-other))) @@ -5845,6 +6711,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(prodigy-green-face ((,class :foreground ,green))) `(prodigy-red-face ((,class :foreground ,red))) `(prodigy-yellow-face ((,class :foreground ,yellow))) +;;;;; pulse + `(pulse-highlight-start-face ((,class :background ,bg-active-accent :extend t))) ;;;;; quick-peek `(quick-peek-background-face ((,class :background ,bg-alt))) `(quick-peek-border-face ((,class :background ,fg-window-divider-inner :height 1))) @@ -5911,7 +6779,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(rcirc-nick-in-message ((,class :foreground ,magenta-alt-other))) `(rcirc-nick-in-message-full-line ((,class :inherit bold :foreground ,fg-special-mild))) `(rcirc-other-nick ((,class :inherit bold :foreground ,fg-special-cold))) - `(rcirc-prompt ((,class :inherit comint-highlight-prompt))) + `(rcirc-prompt ((,class :inherit modus-themes-prompt))) `(rcirc-server ((,class :foreground ,fg-unfocused))) `(rcirc-timestamp ((,class :foreground ,blue-nuanced-fg))) `(rcirc-url ((,class :foreground ,blue :underline t))) @@ -5997,6 +6865,7 @@ by virtue of calling either of `modus-themes-load-operandi' and :background ,@(pcase modus-themes-completions ('opinionated (list bg-active)) (_ (list bg-inactive)))))) + `(selectrum-mouse-highlight ((,class :inherit highlight))) `(selectrum-primary-highlight ((,class :inherit bold ,@(modus-themes--standard-completions @@ -6053,6 +6922,12 @@ by virtue of calling either of `modus-themes-load-operandi' and `(show-paren-match-expression ((,class :background ,bg-paren-expression))) `(show-paren-mismatch ((,class :inherit modus-themes-intense-red))) ;;;;; shr + `(shr-h1 ((,class :inherit modus-themes-heading-1))) + `(shr-h2 ((,class :inherit modus-themes-heading-2))) + `(shr-h3 ((,class :inherit modus-themes-heading-3))) + `(shr-h4 ((,class :inherit modus-themes-heading-4))) + `(shr-h5 ((,class :inherit modus-themes-heading-5))) + `(shr-h6 ((,class :inherit modus-themes-heading-6))) `(shr-abbreviation ((,class :inherit modus-themes-lang-note))) `(shr-selected-link ((,class :inherit modus-themes-subtle-red))) ;;;;; side-notes @@ -6309,8 +7184,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(tomatinho-reset-face ((,class :inherit shadow))) ;;;;; transient `(transient-active-infix ((,class :inherit modus-themes-special-mild))) - `(transient-amaranth ((,class :inherit bold :foreground ,yellow))) - `(transient-argument ((,class :inherit bold :foreground ,red-alt))) + `(transient-amaranth ((,class :inherit bold :foreground ,yellow-alt))) + `(transient-argument ((,class :inherit bold :foreground ,green))) `(transient-blue ((,class :inherit bold :foreground ,blue))) `(transient-disabled-suffix ((,class :inherit modus-themes-intense-red))) `(transient-enabled-suffix ((,class :inherit ,@(modus-themes--success-deuteran @@ -6322,8 +7197,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(transient-key ((,class :inherit modus-themes-key-binding))) `(transient-mismatched-key ((,class :underline t))) `(transient-nonstandard-key ((,class :underline t))) - `(transient-pink ((,class :inherit bold :foreground ,magenta))) - `(transient-red ((,class :inherit bold :foreground ,red-intense))) + `(transient-pink ((,class :inherit bold :foreground ,magenta-alt-faint))) + `(transient-red ((,class :inherit bold :foreground ,red-faint))) `(transient-teal ((,class :inherit bold :foreground ,cyan-alt-other))) `(transient-unreachable ((,class :foreground ,fg-unfocused))) `(transient-unreachable-key ((,class :foreground ,fg-unfocused))) @@ -6560,7 +7435,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(whitespace-empty ((,class :inherit modus-themes-intense-magenta))) `(whitespace-hspace ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) `(whitespace-indentation ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) - `(whitespace-line ((,class :background ,bg-alt))) + `(whitespace-line ((,class :inherit modus-themes-subtle-yellow))) `(whitespace-newline ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) `(whitespace-space ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) `(whitespace-space-after-tab ((,class :inherit modus-themes-subtle-magenta))) diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index fa8ba217f0..6ff359d341 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -4,7 +4,7 @@ ;; Author: Protesilaos Stavrou ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 1.4.0 +;; Version: 1.5.0 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: faces, theme, accessibility commit 5260f1f2c3cbd229269c578284ccfe2a39d7b3d4 Author: Lars Ingebrigtsen Date: Thu Jul 15 17:04:00 2021 +0200 Autoload `split-string-shell-command' * lisp/shell.el (split-string-shell-command): Autoload. diff --git a/lisp/shell.el b/lisp/shell.el index 5444b5837c..5aab80d103 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -459,6 +459,7 @@ Useful for shells like zsh that has this feature." (push (mapconcat #'identity (nreverse arg) "") args))) (cons (nreverse args) (nreverse begins))))) +;;;###autoload (defun split-string-shell-command (string) "Split STRING (a shell command) into a list of strings. General shell syntax, like single and double quoting, as well as commit acf583b209549cb533ca6436e5178f4f60027aa4 Author: Eli Zaretskii Date: Thu Jul 15 12:37:26 2021 +0300 Fix 'shell-tests-split-string' on MS-Windows * test/lisp/shell-tests.el (shell-tests-split-string): Skip test that always fails on MS-Windows/MS-DOS. diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el index 1e5de71ad7..c4147088a2 100644 --- a/test/lisp/shell-tests.el +++ b/test/lisp/shell-tests.el @@ -56,7 +56,8 @@ '("ls" "/tmp/foo bar"))) (should (equal (split-string-shell-command "ls /tmp/'foo\\ bar'") '("ls" "/tmp/foo\\ bar"))) - (should (equal (split-string-shell-command "ls /tmp/foo\\ bar") - '("ls" "/tmp/foo bar")))) + (unless (memq system-type '(windows-nt ms-dos)) + (should (equal (split-string-shell-command "ls /tmp/foo\\ bar") + '("ls" "/tmp/foo bar"))))) ;;; shell-tests.el ends here commit 07392da96d608b525529e15f1d04ebc6c0e4d15b Merge: 0c28223bb2 0848af9f66 Author: Eli Zaretskii Date: Thu Jul 15 12:23:50 2021 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 0848af9f6633fa997fd6390aee62e64cb226b06e Author: Lars Ingebrigtsen Date: Thu Jul 15 11:22:52 2021 +0200 Improve the `window-end' doc string * src/window.c (Fwindow_end): Be more explicit about what the position is (bug#13429). diff --git a/src/window.c b/src/window.c index db324effcc..a6e8ee0d53 100644 --- a/src/window.c +++ b/src/window.c @@ -1723,14 +1723,16 @@ have been if redisplay had finished, do this: DEFUN ("window-end", Fwindow_end, Swindow_end, 0, 2, 0, doc: /* Return position at which display currently ends in WINDOW. -WINDOW must be a live window and defaults to the selected one. -This is updated by redisplay, when it runs to completion. -Simply changing the buffer text or setting `window-start' -does not update this value. +This is the position after the final character in WINDOW. + +WINDOW must be a live window and defaults to the selected one. This +is updated by redisplay, when it runs to completion. Simply changing +the buffer text or setting `window-start' does not update this value. + Return nil if there is no recorded value. (This can happen if the -last redisplay of WINDOW was preempted, and did not finish.) -If UPDATE is non-nil, compute the up-to-date position -if it isn't already recorded. */) +last redisplay of WINDOW was preempted, and did not finish.) If +UPDATE is non-nil, compute the up-to-date position if it isn't already +recorded. */) (Lisp_Object window, Lisp_Object update) { Lisp_Object value; commit 0c28223bb2dc5f6aafaaee88c5a7f723f618484a Author: Eli Zaretskii Date: Thu Jul 15 12:22:47 2021 +0300 ; * etc/NEWS: Fix wording in a recent addition. diff --git a/etc/NEWS b/etc/NEWS index 7388a0f625..3dfd9f1894 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2972,8 +2972,9 @@ The former is now declared obsolete. +++ *** New function 'split-string-shell-command'. -This splits a shell string into separate components, respecting single -and double quotes, as well as backslash quoting. +This splits a shell command string into separate components, +respecting quoting with single ('like this') and double ("like this") +quotes, as well as backslash quoting (like\ this). --- *** ':safe' settings in 'defcustom' are now propagated to the loaddefs files. commit 9eee02886dcfab451ad9559bad3948d78b483447 Author: Eli Zaretskii Date: Thu Jul 15 12:22:27 2021 +0300 ; * lisp/gnus/message.el (message-signature-separator): Add :version. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 2c0663915f..cdabdef2ec 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1660,7 +1660,8 @@ starting with `not' and followed by regexps." (defface message-signature-separator '((t :bold t)) "Face used for displaying the signature separator." - :group 'message-faces) + :group 'message-faces + :version "28.1") (defun message-match-to-eoh (_limit) (let ((start (point))) commit 4aac8f60e688076980d2103d275a78609c03be16 Author: Lars Ingebrigtsen Date: Thu Jul 15 10:37:11 2021 +0200 Mention more split-string-* functions in shortdoc * lisp/emacs-lisp/shortdoc.el (string): Mention split-string-and-unquote and split-string-shell-command. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 4df404015a..1d2c52454b 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -162,6 +162,10 @@ There can be any number of :example/:result elements." :eval (split-string "foo bar") :eval (split-string "|foo|bar|" "|") :eval (split-string "|foo|bar|" "|" t)) + (split-string-and-unquote + :eval (split-string-and-unquote "foo \"bar zot\"")) + (split-string-shell-command + :eval (split-string-shell-command "ls /tmp/'foo bar'")) (string-lines :eval (string-lines "foo\n\nbar") :eval (string-lines "foo\n\nbar" t)) commit eb4a120ea580bf628f65ff7e571016d5efa2293e Author: Lars Ingebrigtsen Date: Thu Jul 15 10:33:22 2021 +0200 Allow using spaces in `inferior-lisp' command names * lisp/progmodes/inf-lisp.el (inferior-lisp): Allow using spaces in the command names (by splitting using shell syntax) (bug#16005). diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 0a72ae96bb..e69a9ff394 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -62,6 +62,7 @@ (require 'comint) (require 'lisp-mode) +(require 'shell) (defgroup inferior-lisp nil @@ -289,15 +290,20 @@ to continue it." "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'. If there is a process already running in `*inferior-lisp*', just switch to that buffer. + With argument, allows you to edit the command line (default is value of `inferior-lisp-program'). Runs the hooks from `inferior-lisp-mode-hook' (after the `comint-mode-hook' is run). + +If any parts of the command name contains spaces, they should be +quoted using shell quote syntax. + \(Type \\[describe-mode] in the process buffer for a list of commands.)" (interactive (list (if current-prefix-arg (read-string "Run lisp: " inferior-lisp-program) inferior-lisp-program))) (if (not (comint-check-proc "*inferior-lisp*")) - (let ((cmdlist (split-string cmd))) + (let ((cmdlist (split-string-shell-command cmd))) (set-buffer (apply (function make-comint) "inferior-lisp" (car cmdlist) nil (cdr cmdlist))) (inferior-lisp-mode))) commit 28e7b5104141225f997c82c168a5e60a80caaf3e Author: Lars Ingebrigtsen Date: Thu Jul 15 10:29:04 2021 +0200 Rename shell-split-string to split-string-shell-command * lisp/shell.el (split-string-shell-command): * doc/lispref/processes.texi (Shell Arguments): Rename from shell-split-string. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index c8e9f0cea6..90c4215637 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -247,12 +247,12 @@ protected by @code{shell-quote-argument}; @code{combine-and-quote-strings} is @emph{not} intended to protect special characters from shell evaluation. -@defun shell-split-string string +@defun split-string-shell-command string This function splits @var{string} into substrings, respecting double and single quotes, as well as backslash quoting. @smallexample -(shell-split-string "ls /tmp/'foo bar'") +(split-string-shell-command "ls /tmp/'foo bar'") @result{} ("ls" "/tmp/foo bar") @end smallexample @end defun diff --git a/etc/NEWS b/etc/NEWS index 29c2d9db73..7388a0f625 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2971,7 +2971,7 @@ The former is now declared obsolete. * Lisp Changes in Emacs 28.1 +++ -*** New function 'shell-split-string'. +*** New function 'split-string-shell-command'. This splits a shell string into separate components, respecting single and double quotes, as well as backslash quoting. diff --git a/lisp/shell.el b/lisp/shell.el index 15783bb924..5444b5837c 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -459,7 +459,7 @@ Useful for shells like zsh that has this feature." (push (mapconcat #'identity (nreverse arg) "") args))) (cons (nreverse args) (nreverse begins))))) -(defun shell-split-string (string) +(defun split-string-shell-command (string) "Split STRING (a shell command) into a list of strings. General shell syntax, like single and double quoting, as well as backslash quoting, is respected." diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el index ad54644e55..1e5de71ad7 100644 --- a/test/lisp/shell-tests.el +++ b/test/lisp/shell-tests.el @@ -46,17 +46,17 @@ '(("cd" "ba" "") 1 4 7))))) (ert-deftest shell-tests-split-string () - (should (equal (shell-split-string "ls /tmp") + (should (equal (split-string-shell-command "ls /tmp") '("ls" "/tmp"))) - (should (equal (shell-split-string "ls '/tmp/foo bar'") + (should (equal (split-string-shell-command "ls '/tmp/foo bar'") '("ls" "/tmp/foo bar"))) - (should (equal (shell-split-string "ls \"/tmp/foo bar\"") + (should (equal (split-string-shell-command "ls \"/tmp/foo bar\"") '("ls" "/tmp/foo bar"))) - (should (equal (shell-split-string "ls /tmp/'foo bar'") + (should (equal (split-string-shell-command "ls /tmp/'foo bar'") '("ls" "/tmp/foo bar"))) - (should (equal (shell-split-string "ls /tmp/'foo\\ bar'") + (should (equal (split-string-shell-command "ls /tmp/'foo\\ bar'") '("ls" "/tmp/foo\\ bar"))) - (should (equal (shell-split-string "ls /tmp/foo\\ bar") + (should (equal (split-string-shell-command "ls /tmp/foo\\ bar") '("ls" "/tmp/foo bar")))) ;;; shell-tests.el ends here commit 4fb6cf3f38511f3ca9ceb350a41993015969bdc1 Author: Lars Ingebrigtsen Date: Thu Jul 15 10:25:41 2021 +0200 Add a new function 'shell-split-string' * doc/lispref/processes.texi (Shell Arguments): Document it. * lisp/shell.el (shell-split-string): New function. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 0dfdac7147..c8e9f0cea6 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -247,6 +247,16 @@ protected by @code{shell-quote-argument}; @code{combine-and-quote-strings} is @emph{not} intended to protect special characters from shell evaluation. +@defun shell-split-string string +This function splits @var{string} into substrings, respecting double +and single quotes, as well as backslash quoting. + +@smallexample +(shell-split-string "ls /tmp/'foo bar'") + @result{} ("ls" "/tmp/foo bar") +@end smallexample +@end defun + @defun split-string-and-unquote string &optional separators This function splits @var{string} into substrings at matches for the regular expression @var{separators}, like @code{split-string} does diff --git a/etc/NEWS b/etc/NEWS index 555b465e84..29c2d9db73 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2970,6 +2970,11 @@ The former is now declared obsolete. * Lisp Changes in Emacs 28.1 ++++ +*** New function 'shell-split-string'. +This splits a shell string into separate components, respecting single +and double quotes, as well as backslash quoting. + --- *** ':safe' settings in 'defcustom' are now propagated to the loaddefs files. diff --git a/lisp/shell.el b/lisp/shell.el index 4339e8c0a3..15783bb924 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -459,6 +459,15 @@ Useful for shells like zsh that has this feature." (push (mapconcat #'identity (nreverse arg) "") args))) (cons (nreverse args) (nreverse begins))))) +(defun shell-split-string (string) + "Split STRING (a shell command) into a list of strings. +General shell syntax, like single and double quoting, as well as +backslash quoting, is respected." + (with-temp-buffer + (insert string) + (let ((comint-file-name-quote-list shell-file-name-quote-list)) + (car (shell--parse-pcomplete-arguments))))) + (defun shell-command-completion-function () "Completion function for shell command names. This is the value of `pcomplete-command-completion-function' for diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el index d918de771b..ad54644e55 100644 --- a/test/lisp/shell-tests.el +++ b/test/lisp/shell-tests.el @@ -45,4 +45,18 @@ (should (equal (shell--parse-pcomplete-arguments) '(("cd" "ba" "") 1 4 7))))) +(ert-deftest shell-tests-split-string () + (should (equal (shell-split-string "ls /tmp") + '("ls" "/tmp"))) + (should (equal (shell-split-string "ls '/tmp/foo bar'") + '("ls" "/tmp/foo bar"))) + (should (equal (shell-split-string "ls \"/tmp/foo bar\"") + '("ls" "/tmp/foo bar"))) + (should (equal (shell-split-string "ls /tmp/'foo bar'") + '("ls" "/tmp/foo bar"))) + (should (equal (shell-split-string "ls /tmp/'foo\\ bar'") + '("ls" "/tmp/foo\\ bar"))) + (should (equal (shell-split-string "ls /tmp/foo\\ bar") + '("ls" "/tmp/foo bar")))) + ;;; shell-tests.el ends here commit d4217b38d72be5b4b025260ff9839b51808f9f40 Author: Lars Ingebrigtsen Date: Thu Jul 15 07:17:53 2021 +0200 Clarify overriding-local-map doc string * src/keyboard.c (syms_of_keyboard): Clarify `overriding-local-map' vs. text properties/overlays (bug#16312). diff --git a/src/keyboard.c b/src/keyboard.c index 051f2f8b38..6174a4aad9 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12141,10 +12141,11 @@ terminal device. See Info node `(elisp)Multiple Terminals'. */); DEFVAR_LISP ("overriding-local-map", Voverriding_local_map, doc: /* Keymap that replaces (overrides) local keymaps. If this variable is non-nil, Emacs looks up key bindings in this -keymap INSTEAD OF the keymap char property, minor mode maps, and the -buffer's local map. Hence, the only active keymaps would be -`overriding-terminal-local-map', this keymap, and `global-keymap', in -order of precedence. */); +keymap INSTEAD OF `keymap' text properties, `local-map' and `keymap' +overlay properties, minor mode maps, and the buffer's local map. + +Hence, the only active keymaps would be `overriding-terminal-local-map', +this keymap, and `global-keymap', in order of precedence. */); Voverriding_local_map = Qnil; DEFVAR_LISP ("overriding-local-map-menu-flag", Voverriding_local_map_menu_flag, commit 0afbde4e68c1161a54f9593ecb5b66fe42aa0de4 Author: Paul Eggert Date: Wed Jul 14 17:10:06 2021 -0500 Pacify gcc -Woverflow more clearly * src/alloc.c (mark_maybe_pointer): Make it clearer that ANDing with UINTPTR_MAX is intended. Omit a now-unnecessary cast. diff --git a/src/alloc.c b/src/alloc.c index ee3fd64a00..8edcd06c84 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4764,7 +4764,9 @@ mark_maybe_pointer (void *p, bool symbol_only) from Emacs source code, it can occur in some cases. To fix this problem, the pdumper code should grok non-initial addresses, as the non-pdumper code does. */ - void *po = (void *) ((uintptr_t) p & (uintptr_t) VALMASK); + uintptr_t mask = VALMASK & UINTPTR_MAX; + uintptr_t masked_p = (uintptr_t) p & mask; + void *po = (void *) masked_p; char *cp = p; char *cpo = po; /* Don't use pdumper_object_p_precise here! It doesn't check the commit 525d5cab36fe7e719ecc49b88a1ac68abbe7924c Author: Michael Albinus Date: Wed Jul 14 18:36:14 2021 +0200 Preserve backward compatibility in Tramp * lisp/net/tramp-crypt.el (tramp-crypt-handle-lock-file) (tramp-crypt-handle-unlock-file): Preserve backward compatibility. * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): Do not create lock file twice. * lisp/net/tramp.el (tramp-handle-make-lock-file-name): Move lock file security check ... (tramp-handle-lock-file): ... here. (tramp-handle-unlock-file): Preserve backward compatibility. * test/lisp/net/tramp-tests.el (lock-file-name-transforms) (remote-file-name-inhibit-locks): Declare. (tramp-allow-unsafe-temporary-files): Set to t. (tramp-test37-make-auto-save-file-name) (tramp-test38-find-backup-file-name): Move binding of `tramp-allow-unsafe-temporary-files' up. (tramp-test39-lock-file): Bind `tramp-allow-unsafe-temporary-files'. Preserve backward compatibility. Extend test. diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 109db3b1d7..fdb2907ec3 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -809,7 +809,9 @@ WILDCARD is not supported." (defun tramp-crypt-handle-lock-file (filename) "Like `lock-file' for Tramp files." (let (tramp-crypt-enabled) - (lock-file (tramp-crypt-encrypt-file-name filename)))) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall + 'lock-file (tramp-crypt-encrypt-file-name filename)))) (defun tramp-crypt-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -865,7 +867,9 @@ WILDCARD is not supported." (defun tramp-crypt-handle-unlock-file (filename) "Like `unlock-file' for Tramp files." (let (tramp-crypt-enabled) - (unlock-file (tramp-crypt-encrypt-file-name filename)))) + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall + 'unlock-file (tramp-crypt-encrypt-file-name filename)))) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 760320d7ed..e6bd42a83a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3272,7 +3272,8 @@ implementation will be used." (or (file-directory-p localname) (file-writable-p localname))) ;; Short track: if we are on the local host, we can run directly. - (write-region start end localname append 'no-message lockname) + (let ((create-lockfiles (not file-locked))) + (write-region start end localname append 'no-message lockname)) (let* ((modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3f586c6217..736c7efd24 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3873,43 +3873,44 @@ Return nil when there is no lockfile." (format "%s@%s.%s" (user-login-name) (system-name) (tramp-get-lock-pid file)))) + + ;; Protect against security hole. + (with-parsed-tramp-file-name file nil + (when (and (not tramp-allow-unsafe-temporary-files) + (file-in-directory-p lockname temporary-file-directory) + (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes file 'integer)) + tramp-unknown-id-integer)) + (not (with-tramp-connection-property + (tramp-get-process v) "unsafe-temporary-file" + (yes-or-no-p + (concat + "Lock file on local temporary directory, " + "do you want to continue? "))))) + (tramp-error v 'file-error "Unsafe lock file name"))) + + ;; Do the lock. (let (create-lockfiles signal-hook-function) (condition-case nil (make-symbolic-link info lockname 'ok-if-already-exists) (error - (write-region info nil lockname) - (set-file-modes lockname #o0644)))))))) + (with-file-modes #o0644 + (write-region info nil lockname))))))))) (defun tramp-handle-make-lock-file-name (file) "Like `make-lock-file-name' for Tramp files." - (when (and create-lockfiles - ;; This variable has been introduced with Emacs 28.1. - (not (bound-and-true-p remote-file-name-inhibit-locks))) - (with-parsed-tramp-file-name file nil - (let ((result - ;; Run plain `make-lock-file-name'. - (tramp-run-real-handler #'make-lock-file-name (list file)))) - ;; Protect against security hole. - (when (and (not tramp-allow-unsafe-temporary-files) - (file-in-directory-p result temporary-file-directory) - (zerop (or (tramp-compat-file-attribute-user-id - (file-attributes file 'integer)) - tramp-unknown-id-integer)) - (not (with-tramp-connection-property - (tramp-get-process v) "unsafe-temporary-file" - (yes-or-no-p - (concat - "Lock file on local temporary directory, " - "do you want to continue? "))))) - (tramp-error v 'file-error "Unsafe lock file name")) - result)))) + (and create-lockfiles + ;; This variable has been introduced with Emacs 28.1. + (not (bound-and-true-p remote-file-name-inhibit-locks)) + (tramp-run-real-handler 'make-lock-file-name (list file)))) (defun tramp-handle-unlock-file (file) "Like `unlock-file' for Tramp files." (when-let ((lockname (tramp-compat-make-lock-file-name file))) (condition-case err (delete-file lockname) - (error (userlock--handle-unlock-error err))))) + ;; `userlock--handle-unlock-error' exists since Emacs 28.1. + (error (tramp-compat-funcall 'userlock--handle-unlock-error err))))) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index bc05db8095..3dd22acea5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -63,6 +63,8 @@ (declare-function tramp-smb-get-localname "tramp-smb") (defvar ange-ftp-make-backup-files) (defvar auto-save-file-name-transforms) +(defvar lock-file-name-transforms) +(defvar remote-file-name-inhibit-locks) (defvar tramp-connection-properties) (defvar tramp-copy-size-limit) (defvar tramp-display-escape-sequence-regexp) @@ -122,6 +124,7 @@ (setq auth-source-save-behavior nil password-cache-expiry nil remote-file-name-inhibit-cache nil + tramp-allow-unsafe-temporary-files t tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil tramp-persistency-file-name nil @@ -5481,7 +5484,8 @@ Use direct async.") (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) - (tmp-name2 (tramp--test-make-temp-name nil quoted))) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + tramp-allow-unsafe-temporary-files) (unwind-protect (progn @@ -5569,8 +5573,7 @@ Use direct async.") ;; Create temporary file. This shall check for sensible ;; files, owned by root. - (let ((tramp-auto-save-directory temporary-file-directory) - tramp-allow-unsafe-temporary-files) + (let ((tramp-auto-save-directory temporary-file-directory)) (write-region "foo" nil tmp-name1) (when (zerop (or (tramp-compat-file-attribute-user-id (file-attributes tmp-name1)) @@ -5606,6 +5609,7 @@ Use direct async.") (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (ange-ftp-make-backup-files t) + tramp-allow-unsafe-temporary-files ;; These settings are not used by Tramp, so we ignore them. version-control delete-old-versions (kept-old-versions (default-toplevel-value 'kept-old-versions)) @@ -5716,7 +5720,6 @@ Use direct async.") ;; Create temporary file. This shall check for sensible ;; files, owned by root. (let ((backup-directory-alist `(("." . ,temporary-file-directory))) - tramp-allow-unsafe-temporary-files tramp-backup-directory-alist) (write-region "foo" nil tmp-name1) (when (zerop (or (tramp-compat-file-attribute-user-id @@ -5749,13 +5752,18 @@ Use direct async.") (skip-unless (not (tramp--test-ange-ftp-p))) ;; Since Emacs 28.1. (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file))) + (skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name))) + ;; `lock-file', `unlock-file', `file-locked-p' and + ;; `make-lock-file-name' exists since Emacs 28.1. We don't want to + ;; see compiler warnings for older Emacsen. (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (remote-file-name-inhibit-cache t) (remote-file-name-inhibit-locks nil) (create-lockfiles t) + tramp-allow-unsafe-temporary-files (inhibit-message t) ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files. (tramp-cleanup-connection-hook @@ -5767,24 +5775,24 @@ Use direct async.") (unwind-protect (progn ;; A simple file lock. - (should-not (file-locked-p tmp-name1)) - (lock-file tmp-name1) - (should (eq (file-locked-p tmp-name1) t)) + (should-not (with-no-warnings (file-locked-p tmp-name1))) + (with-no-warnings (lock-file tmp-name1)) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) ;; If it is locked already, nothing changes. - (lock-file tmp-name1) - (should (eq (file-locked-p tmp-name1) t)) + (with-no-warnings (lock-file tmp-name1)) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) ;; A new connection changes process id, and also the ;; lockname contents. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (stringp (file-locked-p tmp-name1))) + (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) ;; When `remote-file-name-inhibit-locks' is set, nothing happens. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (let ((remote-file-name-inhibit-locks t)) - (lock-file tmp-name1) - (should-not (file-locked-p tmp-name1))) + (with-no-warnings (lock-file tmp-name1)) + (should-not (with-no-warnings (file-locked-p tmp-name1)))) ;; When `lock-file-name-transforms' is set, another lock ;; file is used. @@ -5792,48 +5800,77 @@ Use direct async.") (let ((lock-file-name-transforms `((".*" ,tmp-name2)))) (should (string-equal - (make-lock-file-name tmp-name1) - (make-lock-file-name tmp-name2))) - (lock-file tmp-name1) - (should (eq (file-locked-p tmp-name1) t)) - (unlock-file tmp-name1) - (should-not (file-locked-p tmp-name1))) + (with-no-warnings (make-lock-file-name tmp-name1)) + (with-no-warnings (make-lock-file-name tmp-name2)))) + (with-no-warnings (lock-file tmp-name1)) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) + (with-no-warnings (unlock-file tmp-name1)) + (should-not (with-no-warnings (file-locked-p tmp-name1)))) ;; Steal the file lock. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s))) - (lock-file tmp-name1)) - (should (eq (file-locked-p tmp-name1) t)) + (with-no-warnings (lock-file tmp-name1))) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) ;; Ignore the file lock. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p))) - (lock-file tmp-name1)) - (should (stringp (file-locked-p tmp-name1))) + (with-no-warnings (lock-file tmp-name1))) + (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) ;; Quit the file lock machinery. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) - (should-error (lock-file tmp-name1) :type 'file-locked) + (with-no-warnings + (should-error + (lock-file tmp-name1) + :type 'file-locked)) ;; The same for `write-region'. (should-error - (write-region "foo" nil tmp-name1) :type 'file-locked) + (write-region "foo" nil tmp-name1) + :type 'file-locked) (should-error (write-region "foo" nil tmp-name1 nil nil tmp-name1) :type 'file-locked) ;; The same for `set-visited-file-name'. (with-temp-buffer (should-error - (set-visited-file-name tmp-name1) :type 'file-locked))) - (should (stringp (file-locked-p tmp-name1))) + (set-visited-file-name tmp-name1) + :type 'file-locked))) + (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) (should-not (file-exists-p tmp-name1))) ;; Cleanup. (ignore-errors (delete-file tmp-name1)) - (unlock-file tmp-name1) - (unlock-file tmp-name2) - (should-not (file-locked-p tmp-name1)) - (should-not (file-locked-p tmp-name2)))))) + (with-no-warnings (unlock-file tmp-name1)) + (with-no-warnings (unlock-file tmp-name2)) + (should-not (with-no-warnings (file-locked-p tmp-name1))) + (should-not (with-no-warnings (file-locked-p tmp-name2)))) + + (unwind-protect + ;; Create temporary file. This shall check for sensible + ;; files, owned by root. + (let ((lock-file-name-transforms auto-save-file-name-transforms)) + (write-region "foo" nil tmp-name1) + (when (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes tmp-name1)) + tramp-unknown-id-integer)) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) + (should-error + (write-region "foo" nil tmp-name1) + :type 'file-error)) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'yes-or-no-p) + #'tramp--test-always)) + (write-region "foo" nil tmp-name1)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) ;; The functions were introduced in Emacs 26.1. (ert-deftest tramp-test40-make-nearby-temp-file () commit f45710e1ddf0f3a1470f6bc3a1116afd841de41a Author: Lars Ingebrigtsen Date: Wed Jul 14 18:08:33 2021 +0200 Fontify the signature separator in Message mode * lisp/gnus/message.el (message-signature-separator): New face (bug#17757). (message-font-lock-keywords): Add it to the signature, and ensure that the trailing space isn't removed when hitting RET. (message--match-signature): New helper function. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a9be2d6b34..2c0663915f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1658,6 +1658,10 @@ starting with `not' and followed by regexps." "Face used for displaying MML." :group 'message-faces) +(defface message-signature-separator '((t :bold t)) + "Face used for displaying the signature separator." + :group 'message-faces) + (defun message-match-to-eoh (_limit) (let ((start (point))) (rfc822-goto-eoh) @@ -1751,9 +1755,22 @@ number of levels specified in the faces `message-cited-text-*'." (0 ',cited-text-face)) keywords)) (setq level (1+ level))) - keywords)) + keywords) + ;; Match signature. This `field' stuff ensures that hitting `RET' + ;; after the signature separator doesn't remove the trailing space. + (list + '(message--match-signature (0 '( face message-signature-separator + rear-nonsticky t + field signature))))) "Additional expressions to highlight in Message mode.") +(defun message--match-signature (limit) + (save-excursion + (and (re-search-forward message-signature-separator limit t) + ;; It's the last one in the buffer. + (not (save-excursion + (re-search-forward message-signature-separator nil t)))))) + (defvar message-face-alist '((bold . message-bold-region) (underline . underline-region) commit 7ac411ae2ce91572a2bdb8eaa1ee6ceccf162e35 Author: Eli Zaretskii Date: Wed Jul 14 18:54:11 2021 +0300 ; * src/data.c (Fcar, Fcdr): Doc fix. diff --git a/src/data.c b/src/data.c index 2706a2474e..1c36dff51d 100644 --- a/src/data.c +++ b/src/data.c @@ -591,8 +591,8 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p, /* Extract and set components of lists. */ DEFUN ("car", Fcar, Scar, 1, 1, 0, - doc: /* Return the car of LIST. If arg is nil, return nil. -Error if arg is not nil and not a cons cell. See also `car-safe'. + doc: /* Return the car of LIST. If LIST is nil, return nil. +Error if LIST is not nil and not a cons cell. See also `car-safe'. See Info node `(elisp)Cons Cells' for a discussion of related basic Lisp concepts such as car, cdr, cons cell and list. */) @@ -609,8 +609,8 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, } DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, - doc: /* Return the cdr of LIST. If arg is nil, return nil. -Error if arg is not nil and not a cons cell. See also `cdr-safe'. + doc: /* Return the cdr of LIST. If LIST is nil, return nil. +Error if LIST is not nil and not a cons cell. See also `cdr-safe'. See Info node `(elisp)Cons Cells' for a discussion of related basic Lisp concepts such as cdr, car, cons cell and list. */) commit 6309cae3f2c089fb4a15b5576aecc23e5e25fdb3 Author: Lars Ingebrigtsen Date: Wed Jul 14 17:10:24 2021 +0200 Clarify backward-delete-char-untabify doc string * lisp/simple.el (backward-delete-char-untabify): Mention the effect of Transient Mark mode (bug#17263). diff --git a/lisp/simple.el b/lisp/simple.el index f746d738a6..322693f631 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5842,7 +5842,13 @@ Can be `untabify' -- turn a tab to many spaces, then delete one space; (defun backward-delete-char-untabify (arg &optional killp) "Delete characters backward, changing tabs into spaces. The exact behavior depends on `backward-delete-char-untabify-method'. + Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil. + +If Transient Mark mode is enabled, the mark is active, and ARG is 1, +delete the text in the region and deactivate the mark instead. +To disable this, set option ‘delete-active-region’ to nil. + Interactively, ARG is the prefix arg (default 1) and KILLP is t if a prefix arg was specified." (interactive "*p\nP") commit 5796e0063cc471eaea47a7d781bcc5b5c697ea67 Author: Lars Ingebrigtsen Date: Wed Jul 14 16:51:26 2021 +0200 * etc/NEWS: Add back a missing apostrophe. diff --git a/etc/NEWS b/etc/NEWS index cdd14894bc..555b465e84 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2187,7 +2187,8 @@ summaries will include the failing condition. +++ *** New utility function 'insert-into-buffer'. -This is like 'insert-buffer-substring, but works in the opposite direction. +This is like 'insert-buffer-substring', but works in the opposite +direction. +++ *** New user option 'lock-file-name-transforms'. commit 9a534506baa3c2aef98cac0a680530e5b0608ee7 Author: Lars Ingebrigtsen Date: Wed Jul 14 16:40:14 2021 +0200 switch-to-buffer-other-frame doc string improvement * lisp/window.el (switch-to-buffer-other-frame): Document that we don't always display the buffer in a different frame (bug#17719). diff --git a/lisp/window.el b/lisp/window.el index c0511bec4c..0346397566 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8733,6 +8733,13 @@ documentation for additional customization information." BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil. Return the buffer switched to. +This uses the function `display-buffer' as a subroutine to +display the buffer; see its documentation for additional +customization information. By default, if the buffer is already +displayed (even in the current frame), that window is selected. +If the buffer isn't displayed in any frame, a new frame is popped +up and the buffer is displayed there. + If called interactively, read the buffer name using `read-buffer'. The variable `confirm-nonexistent-file-or-buffer' determines whether to request confirmation before creating a new buffer. @@ -8744,10 +8751,7 @@ buffer, create a new buffer with that name. If BUFFER-OR-NAME is nil, switch to the buffer returned by `other-buffer'. Optional second arg NORECORD non-nil means do not put this -buffer at the front of the list of recently selected ones. - -This uses the function `display-buffer' as a subroutine; see its -documentation for additional customization information." +buffer at the front of the list of recently selected ones." (interactive (list (read-buffer-to-switch "Switch to buffer in other frame: "))) (pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord)) commit 6ff726362d5dea6bc2f21401dc4f22ba37aacac0 Author: Lars Ingebrigtsen Date: Wed Jul 14 12:42:35 2021 +0200 Fix hilit-chg highlighting of characters where text has been removed * lisp/hilit-chg.el (hilit-chg-set-face-on-change): Remove highlighting from characters that are just highlighted because of something that has been previously deleted (bug#17784). diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 3c3c407398..8919e98238 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -492,9 +492,9 @@ This allows you to manually remove highlighting from uninteresting changes." ;; otherwise an undone change shows up as changed. While the properties ;; are automatically restored by undo, we must fix up the overlay. (save-match-data - (let (;;(beg-decr 1) - (end-incr 1) - (type 'hilit-chg)) + (let ((end-incr 1) + (type 'hilit-chg) + (property 'hilit-chg)) (if undo-in-progress (if (and highlight-changes-mode highlight-changes-visible-mode) @@ -515,7 +515,8 @@ This allows you to manually remove highlighting from uninteresting changes." ;; (setq beg-decr 0)))) ;; (setq beg (max (- beg beg-decr) (point-min))) (setq end (min (+ end end-incr) (point-max))) - (setq type 'hilit-chg-delete)) + (setq type 'hilit-chg-delete + property 'hilit-chg-delete)) ;; Not a deletion. ;; Most of the time the following is not necessary, but ;; if the current text was marked as a deletion then @@ -523,14 +524,15 @@ This allows you to manually remove highlighting from uninteresting changes." ;; text where she earlier deleted text, we have to remove the ;; deletion marking, and replace it explicitly with a `changed' ;; marking, otherwise its highlighting would disappear. - (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete) - (save-restriction - (widen) - (put-text-property end (+ end 1) 'hilit-chg 'hilit-chg) - (if highlight-changes-visible-mode - (hilit-chg-fixup end (+ end 1)))))) + (when (eq (get-text-property end 'hilit-chg-delete) + 'hilit-chg-delete) + (save-restriction + (widen) + (put-text-property end (+ end 1) 'hilit-chg-delete nil) + (if highlight-changes-visible-mode + (hilit-chg-fixup end (+ end 1)))))) (unless no-property-change - (put-text-property beg end 'hilit-chg type)) + (put-text-property beg end property type)) (if (or highlight-changes-visible-mode no-property-change) (hilit-chg-make-ov type beg end))))))) commit 8168a792ca953a24c5edfb37986e4d4e0467b5c7 Author: Eli Zaretskii Date: Wed Jul 14 15:27:19 2021 +0300 Fix deprecation warnings from libtiff * src/image.c (UINT32) [TIFFLIB_VERSION >= 20210416]: Define to use stdint.h type for recent libtiff versions. Reported by Andy Moreton . diff --git a/src/image.c b/src/image.c index e2f3220dd2..bcd45eb451 100644 --- a/src/image.c +++ b/src/image.c @@ -7774,6 +7774,13 @@ tiff_image_p (Lisp_Object object) # include +/* libtiff version 4.3.0 deprecated uint32 typedef. */ +#if TIFFLIB_VERSION >= 20210416 +# define UINT32 uint32_t +#else +# define UINT32 uint32 +#endif + # ifdef WINDOWSNT /* TIFF library details. */ @@ -7785,7 +7792,7 @@ DEF_DLL_FN (TIFF *, TIFFClientOpen, TIFFReadWriteProc, TIFFSeekProc, TIFFCloseProc, TIFFSizeProc, TIFFMapFileProc, TIFFUnmapFileProc)); DEF_DLL_FN (int, TIFFGetField, (TIFF *, ttag_t, ...)); -DEF_DLL_FN (int, TIFFReadRGBAImage, (TIFF *, uint32, uint32, uint32 *, int)); +DEF_DLL_FN (int, TIFFReadRGBAImage, (TIFF *, UINT32, UINT32, UINT32 *, int)); DEF_DLL_FN (void, TIFFClose, (TIFF *)); DEF_DLL_FN (int, TIFFSetDirectory, (TIFF *, tdir_t)); @@ -7977,7 +7984,7 @@ tiff_load (struct frame *f, struct image *img) Lisp_Object specified_data; TIFF *tiff; int width, height, x, y, count; - uint32 *buf; + UINT32 *buf; int rc; Emacs_Pix_Container ximg; tiff_memory_source memsrc; @@ -8103,11 +8110,11 @@ tiff_load (struct frame *f, struct image *img) /* Process the pixel raster. Origin is in the lower-left corner. */ for (y = 0; y < height; ++y) { - uint32 *row = buf + y * width; + UINT32 *row = buf + y * width; for (x = 0; x < width; ++x) { - uint32 abgr = row[x]; + UINT32 abgr = row[x]; int r = TIFFGetR (abgr) << 8; int g = TIFFGetG (abgr) << 8; int b = TIFFGetB (abgr) << 8; commit 10f18ff13b8bc416553d7b7ae250bff1fc499280 Author: Michael Albinus Date: Wed Jul 14 13:58:04 2021 +0200 * etc/NEWS (insert-into-buffer'): Fix thinko. diff --git a/etc/NEWS b/etc/NEWS index a0b62250d8..cdd14894bc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2187,7 +2187,7 @@ summaries will include the failing condition. +++ *** New utility function 'insert-into-buffer'. -This is like 'insert-into-buffer', but works in the opposite direction. +This is like 'insert-buffer-substring, but works in the opposite direction. +++ *** New user option 'lock-file-name-transforms'. commit c218aa5b533be22f3a97a2d2a330de0907c7c34e Author: Lars Ingebrigtsen Date: Wed Jul 14 12:11:52 2021 +0200 Make `apropos-library' also work for libraries without symbols * lisp/apropos.el (apropos--preamble): Factor out (bug#17832)... (apropos-print-doc): ... from here. (apropos-library): Use it to display the apropos buffer even if it has no symbols of its own. diff --git a/lisp/apropos.el b/lisp/apropos.el index f2460643ab..376c1b2cbc 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -724,22 +724,27 @@ the output includes key-bindings of commands." ;; (autoload (push (cdr x) autoloads)) ('require (push (cdr x) requires)) ('provide (push (cdr x) provides)) - ('t nil) ; Skip "was an autoload" entries. + ('t nil) ; Skip "was an autoload" entries. ;; FIXME: Print information about each individual method: both ;; its docstring and specializers (bug#21422). ('cl-defmethod (push (cadr x) provides)) (_ (push (or (cdr-safe x) x) symbols)))) - (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal. - (apropos-symbols-internal - symbols apropos-do-all - (concat - (format-message - "Library `%s' provides: %s\nand requires: %s" - file - (mapconcat #'apropos-library-button - (or provides '(nil)) " and ") - (mapconcat #'apropos-library-button - (or requires '(nil)) " and "))))))) + (let ((apropos-pattern "") ;Dummy binding for apropos-symbols-internal. + (text + (concat + (format-message + "Library `%s' provides: %s\nand requires: %s" + file + (mapconcat #'apropos-library-button + (or provides '(nil)) " and ") + (mapconcat #'apropos-library-button + (or requires '(nil)) " and "))))) + (if (null symbols) + (with-output-to-temp-buffer "*Apropos*" + (with-current-buffer standard-output + (apropos-mode) + (apropos--preamble text))) + (apropos-symbols-internal symbols apropos-do-all text))))) (defun apropos-symbols-internal (symbols keys &optional text) ;; Filter out entries that are marked as apropos-inhibit. @@ -1154,10 +1159,7 @@ as a heading." symbol item) (set-buffer standard-output) (apropos-mode) - (insert (substitute-command-keys "Type \\[apropos-follow] on ") - (if apropos-multi-type "a type label" "an entry") - " to view its full documentation.\n\n") - (if text (insert text "\n\n")) + (apropos--preamble text) (dolist (apropos-item p) (when (and spacing (not (bobp))) (princ spacing)) @@ -1287,6 +1289,14 @@ as a heading." (fill-region opoint (point) nil t))) (or (bolp) (terpri))))) +(defun apropos--preamble (text) + (let ((inhibit-read-only t)) + (insert (substitute-command-keys "Type \\[apropos-follow] on ") + (if apropos-multi-type "a type label" "an entry") + " to view its full documentation.\n\n") + (when text + (insert text "\n\n")))) + (defun apropos-follow () "Invokes any button at point, otherwise invokes the nearest label button." (interactive) commit dd34bef7d3769a8574bcee2c1e91e8445129af75 Author: Juri Linkov Date: Wed Jul 14 02:21:17 2021 +0300 Revert e0619995594d1686afd0493391417d6f900d632c that added save-match-data. * lisp/isearch.el (isearch-filter-predicate): Mention precautions against clobbering the match data in docstring (bug#49534). diff --git a/lisp/isearch.el b/lisp/isearch.el index 4bc5956e50..922ab0f6ad 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -233,6 +233,7 @@ called with the positions of the start and the end of the text matched by Isearch and replace commands. If this function returns nil, Isearch and replace commands will continue searching without stopping at resp. replacing this match. +This function is expected to be careful not to clobber the match data. If you use `add-function' to modify this variable, you can use the `isearch-message-prefix' advice property to specify the prefix string @@ -3529,9 +3530,8 @@ Optional third argument, if t, means if fail just return nil (no error). ;; Clear RETRY unless the search predicate says ;; to skip this search hit. (if (or (not isearch-success) - (save-match-data - (funcall isearch-filter-predicate - (match-beginning 0) (match-end 0)))) + (funcall isearch-filter-predicate + (match-beginning 0) (match-end 0))) (setq retry nil) ;; Advance point on empty matches before retrying (when (= (match-beginning 0) (match-end 0)) @@ -4049,9 +4049,8 @@ Attempt to do the search exactly the way the pending Isearch would." ;; to skip this search hit. (if (or (not success) (= (match-beginning 0) (match-end 0)) - (save-match-data - (funcall isearch-filter-predicate - (match-beginning 0) (match-end 0)))) + (funcall isearch-filter-predicate + (match-beginning 0) (match-end 0))) (setq retry nil))) success) (error nil))) commit e0619995594d1686afd0493391417d6f900d632c Author: Juri Linkov Date: Wed Jul 14 01:29:53 2021 +0300 * lisp/isearch.el: Add save-match-data for funcall isearch-filter-predicate. * lisp/isearch.el (isearch-search): Add save-match-data before funcall isearch-filter-predicate. (isearch-lazy-highlight-search): Add save-match-data before funcall isearch-filter-predicate. (Bug#49534) diff --git a/lisp/isearch.el b/lisp/isearch.el index d1b9f2c439..4bc5956e50 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3529,8 +3529,9 @@ Optional third argument, if t, means if fail just return nil (no error). ;; Clear RETRY unless the search predicate says ;; to skip this search hit. (if (or (not isearch-success) - (funcall isearch-filter-predicate - (match-beginning 0) (match-end 0))) + (save-match-data + (funcall isearch-filter-predicate + (match-beginning 0) (match-end 0)))) (setq retry nil) ;; Advance point on empty matches before retrying (when (= (match-beginning 0) (match-end 0)) @@ -4048,8 +4049,9 @@ Attempt to do the search exactly the way the pending Isearch would." ;; to skip this search hit. (if (or (not success) (= (match-beginning 0) (match-end 0)) - (funcall isearch-filter-predicate - (match-beginning 0) (match-end 0))) + (save-match-data + (funcall isearch-filter-predicate + (match-beginning 0) (match-end 0)))) (setq retry nil))) success) (error nil))) commit f339cc3b81e28cabfd583c862b5011ac40acf935 Author: Lars Ingebrigtsen Date: Wed Jul 14 00:12:45 2021 +0200 Add a better interactive spec to `facemenu-add-face' * lisp/facemenu.el (facemenu-add-face): Use `read-face-name' (bug#18369) by copying over the interactive spec from facemenu-set-face. diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 8631be917a..7229d6163d 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -718,7 +718,13 @@ they are used to set the face information. As a special case, if FACE is `default', then the region is left with NO face text property. Otherwise, selecting the default face would not have any effect. See `facemenu-remove-face-function'." - (interactive "*xFace: \nr") + (interactive (list (progn + (barf-if-buffer-read-only) + (read-face-name "Use face" (face-at-point t))) + (if (and mark-active (not current-prefix-arg)) + (region-beginning)) + (if (and mark-active (not current-prefix-arg)) + (region-end)))) (cond ((and (eq face 'default) (not (eq facemenu-remove-face-function t))) commit a5d1bd6a6d9cd4b8c832e9dcecb1b908ae973fa9 Author: Lars Ingebrigtsen Date: Tue Jul 13 23:48:04 2021 +0200 Make jka-compr-insert-file-contents slightly more efficient * lisp/jka-compr.el (jka-compr-insert-file-contents): Make more efficient by using `insert-into-buffer'. diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 692b6b4adf..658ea44a34 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -415,18 +415,17 @@ There should be no more than seven characters after the final `/'." (fboundp uncompress-function)) ;; If we don't have the uncompression program, then use the ;; internal uncompression function (if we have one). - (progn - (insert - (with-temp-buffer - (set-buffer-multibyte nil) - (insert-file-contents-literally file) - (funcall uncompress-function (point-min) (point-max)) - (when end - (delete-region end (point-max))) - (when beg - (delete-region (point-min) beg)) - (setq size (buffer-size)) - (buffer-string))) + (let ((buf (current-buffer))) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally file) + (funcall uncompress-function (point-min) (point-max)) + (when end + (delete-region end (point-max))) + (when beg + (delete-region (point-min) beg)) + (setq size (buffer-size)) + (insert-into-buffer buf)) (goto-char (point-min))) ;; Use the external uncompression program. (condition-case error-code commit 210b10f3fe7d2b847f7af31276c05001c8fc0ed7 Author: Lars Ingebrigtsen Date: Tue Jul 13 23:46:16 2021 +0200 Add new function 'insert-into-buffer' * doc/lispref/text.texi (Insertion): Document it. * lisp/subr.el (insert-into-buffer): New function. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index feb9e58f31..6fbb475a32 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -500,6 +500,15 @@ We hold these truth@point{} @defun insert-buffer-substring-no-properties from-buffer-or-name &optional start end This is like @code{insert-buffer-substring} except that it does not copy any text properties. +@end defun + +@defun insert-into-buffer to-buffer &optional start end +This is like @code{insert-buffer-substring}, but works in the opposite +direction: The text is copied from the current buffer into +@var{to-buffer}. The block of text is copied to the current point in +@var{to-buffer}, and point (in that buffer) is advanced to after the +end of the copied text. Is @code{start}/@code{end} is @code{nil}, the +entire text in the current buffer is copied over. @end defun @xref{Sticky Properties}, for other insertion functions that inherit diff --git a/etc/NEWS b/etc/NEWS index a3f12837f7..a0b62250d8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2185,6 +2185,10 @@ summaries will include the failing condition. ** Miscellaneous ++++ +*** New utility function 'insert-into-buffer'. +This is like 'insert-into-buffer', but works in the opposite direction. + +++ *** New user option 'lock-file-name-transforms'. This option allows controlling where lock files are written. It uses diff --git a/lisp/subr.el b/lisp/subr.el index e49c277335..c7e18646bf 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3850,6 +3850,14 @@ Before insertion, process text properties according to (insert-buffer-substring buffer start end) (remove-yank-excluded-properties opoint (point)))) +(defun insert-into-buffer (buffer &optional start end) + "Insert the contents of the current buffer into BUFFER. +If START/END, only insert that region from the current buffer. +Point in BUFFER will be placed after the inserted text." + (let ((current (current-buffer))) + (with-current-buffer buffer + (insert-buffer-substring current start end)))) + (defun yank-handle-font-lock-face-property (face start end) "If `font-lock-defaults' is nil, apply FACE as a `face' property. START and END denote the start and end of the text to act on. commit 3ce37f5afa7d7852b0c69b355f531682efebc832 Author: Lars Ingebrigtsen Date: Tue Jul 13 23:23:11 2021 +0200 Fall back on zlib-decompress-region if gzip doesn't exist * lisp/jka-cmpr-hook.el (jka-compr-info-uncompress-function): New function (bug#18823). (jka-compr-compression-info-list): Expand info with decompression function. * lisp/jka-compr.el (jka-compr-insert-file-contents): Fall back on internal decompression function if external doesn't exist. diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 11d93a6df9..eadf5f0d50 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -104,6 +104,9 @@ Otherwise, it is nil.") (defun jka-compr-info-can-append (info) (aref info 7)) (defun jka-compr-info-strip-extension (info) (aref info 8)) (defun jka-compr-info-file-magic-bytes (info) (aref info 9)) +(defun jka-compr-info-uncompress-function (info) + (and (> (length info) 10) + (aref info 10))) (defun jka-compr-get-compression-info (filename) @@ -197,13 +200,15 @@ options through Custom does this automatically." ;;[regexp ;; compr-message compr-prog compr-args ;; uncomp-message uncomp-prog uncomp-args - ;; can-append strip-extension-flag file-magic-bytes] + ;; can-append strip-extension-flag file-magic-bytes + ;; uncompress-function] (mapcar 'purecopy '(["\\.Z\\'" "compressing" "compress" ("-c") ;; gzip is more common than uncompress. It can only read, not write. "uncompressing" "gzip" ("-c" "-q" "-d") - nil t "\037\235"] + nil t "\037\235" + zlib-decompress-region] ;; Formerly, these had an additional arg "-c", but that fails with ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and ;; "Version 0.9.0b, 9-Sept-98". @@ -218,11 +223,13 @@ options through Custom does this automatically." ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'" "compressing" "gzip" ("-c" "-q") "uncompressing" "gzip" ("-c" "-q" "-d") - t nil "\037\213"] + t nil "\037\213" + zlib-decompress-region] ["\\.g?z\\'" "compressing" "gzip" ("-c" "-q") "uncompressing" "gzip" ("-c" "-q" "-d") - t t "\037\213"] + t t "\037\213" + zlib-decompress-region] ["\\.lz\\'" "Lzip compressing" "lzip" ("-c" "-q") "Lzip uncompressing" "lzip" ("-c" "-q" "-d") diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 2f98c8d9ff..692b6b4adf 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -386,6 +386,7 @@ There should be no more than seven characters after the final `/'." (let ((uncompress-message (jka-compr-info-uncompress-message info)) (uncompress-program (jka-compr-info-uncompress-program info)) + (uncompress-function (jka-compr-info-uncompress-function info)) (uncompress-args (jka-compr-info-uncompress-args info)) (base-name (file-name-nondirectory filename)) (notfound nil) @@ -409,58 +410,77 @@ There should be no more than seven characters after the final `/'." jka-compr-verbose (message "%s %s..." uncompress-message base-name)) - (condition-case error-code - - (let ((coding-system-for-read 'no-conversion)) - (if replace - (goto-char (point-min))) - (setq start (point)) - (if (or beg end) - (jka-compr-partial-uncompress uncompress-program - (concat uncompress-message - " " base-name) - uncompress-args - local-file - (or beg 0) - (if (and beg end) - (- end beg) - end)) - ;; If visiting, bind off buffer-file-name so that - ;; file-locking will not ask whether we should - ;; really edit the buffer. - (let ((buffer-file-name - (if visit nil buffer-file-name))) - (jka-compr-call-process uncompress-program - (concat uncompress-message - " " base-name) - local-file - t - nil - uncompress-args))) - (setq size (- (point) start)) - (if replace - (delete-region (point) (point-max))) - (goto-char start)) - (error - ;; If the file we wanted to uncompress does not exist, - ;; handle that according to VISIT as `insert-file-contents' - ;; would, maybe signaling the same error it normally would. - (if (and (eq (car error-code) 'file-missing) - (eq (nth 3 error-code) local-file)) - (if visit - (setq notfound error-code) - (signal 'file-missing - (cons "Opening input file" - (nthcdr 2 error-code)))) - ;; If the uncompression program can't be found, - ;; signal that as a non-file error - ;; so that find-file-noselect-1 won't handle it. - (if (and (memq 'file-error (get (car error-code) - 'error-conditions)) - (equal (cadr error-code) "Searching for program")) - (error "Uncompression program `%s' not found" - (nth 3 error-code))) - (signal (car error-code) (cdr error-code)))))) + (if (and (not (executable-find uncompress-program)) + uncompress-function + (fboundp uncompress-function)) + ;; If we don't have the uncompression program, then use the + ;; internal uncompression function (if we have one). + (progn + (insert + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally file) + (funcall uncompress-function (point-min) (point-max)) + (when end + (delete-region end (point-max))) + (when beg + (delete-region (point-min) beg)) + (setq size (buffer-size)) + (buffer-string))) + (goto-char (point-min))) + ;; Use the external uncompression program. + (condition-case error-code + + (let ((coding-system-for-read 'no-conversion)) + (if replace + (goto-char (point-min))) + (setq start (point)) + (if (or beg end) + (jka-compr-partial-uncompress + uncompress-program + (concat uncompress-message " " base-name) + uncompress-args + local-file + (or beg 0) + (if (and beg end) + (- end beg) + end)) + ;; If visiting, bind off buffer-file-name so that + ;; file-locking will not ask whether we should + ;; really edit the buffer. + (let ((buffer-file-name + (if visit nil buffer-file-name))) + (jka-compr-call-process uncompress-program + (concat uncompress-message + " " base-name) + local-file + t + nil + uncompress-args))) + (setq size (- (point) start)) + (if replace + (delete-region (point) (point-max))) + (goto-char start)) + (error + ;; If the file we wanted to uncompress does not exist, + ;; handle that according to VISIT as `insert-file-contents' + ;; would, maybe signaling the same error it normally would. + (if (and (eq (car error-code) 'file-missing) + (eq (nth 3 error-code) local-file)) + (if visit + (setq notfound error-code) + (signal 'file-missing + (cons "Opening input file" + (nthcdr 2 error-code)))) + ;; If the uncompression program can't be found, + ;; signal that as a non-file error + ;; so that find-file-noselect-1 won't handle it. + (if (and (memq 'file-error (get (car error-code) + 'error-conditions)) + (equal (cadr error-code) "Searching for program")) + (error "Uncompression program `%s' not found" + (nth 3 error-code))) + (signal (car error-code) (cdr error-code))))))) (and local-copy commit e368f5603734394525417c886b0b3871aef72755 Author: Daniel Martín Date: Tue Jul 13 22:09:43 2021 +0200 Fix dired-number-of-marked-files when there are no marked files * lisp/dired.el (dired-number-of-marked-files): Fix if expression so that the else part is evaluated correctly. diff --git a/lisp/dired.el b/lisp/dired.el index da803feaa1..28448be06c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3850,13 +3850,13 @@ object files--just `.o' will mark more than you might think." when (stringp file) sum (file-attribute-size (file-attributes file))))) (if (zerop nmarked) - (message "No marked files")) - (message "%d marked file%s (%s total size)" - nmarked - (if (= nmarked 1) - "" - "s") - (funcall byte-count-to-string-function size)))) + (message "No marked files") + (message "%d marked file%s (%s total size)" + nmarked + (if (= nmarked 1) + "" + "s") + (funcall byte-count-to-string-function size))))) (defun dired-mark-files-containing-regexp (regexp &optional marker-char) "Mark all files with contents containing REGEXP for use in later commands. commit 83ded11b0311d4971bca10a5d3173d66185adfee Author: Stefan Monnier Date: Tue Jul 13 16:18:25 2021 -0400 * doc/lispref/modes.texi (Multiline Font Lock): Tweak last change diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index d271db8e3f..7214948850 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3551,7 +3551,7 @@ which will instruct font-lock not to start or end the scan in the middle of the construct. @end itemize - There are three ways to do rehighlighting of multiline constructs: + There are several ways to do rehighlighting of multiline constructs: @itemize @item @@ -3573,15 +3573,18 @@ This works only if @code{jit-lock-contextually} is used, and with the same delay before rehighlighting, but like @code{font-lock-multiline}, it also handles the case where highlighting depends on subsequent lines. -@end itemize - -If parsing the syntax of a construct depends on it being parsed in one +@item +If parsing the @emph{syntax} of a construct depends on it being parsed in one single chunk, you can add the @code{syntax-multiline} text property over the construct in question. The most common use for this is when -the syntax to use for @samp{FOO} depends on some later text +the syntax property to apply to @samp{FOO} depend on some later text @samp{BAR}: By placing this text property over the whole of @samp{FOO...BAR}, you make sure that any change of @samp{BAR} will -cause the syntax of @samp{FOO} to be recomputed. +also cause the syntax property of @samp{FOO} to be recomputed. +Note: For this to work, the mode needs to add +@code{syntax-propertize-multiline} to +@code{syntax-propertize-extend-region-functions}. +@end itemize @menu * Font Lock Multiline:: Marking multiline chunks with a text property. commit eae23d60f8338ea4e8617b13f4f6aa06333f68cd Author: Lars Ingebrigtsen Date: Tue Jul 13 21:48:49 2021 +0200 Allow not updating Customize settings in set-frame-font * lisp/frame.el (set-frame-font): Allow not updating the Customization settings (bug#19298). diff --git a/lisp/frame.el b/lisp/frame.el index aff1d479ec..378d7c8e5b 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1397,7 +1397,7 @@ FRAME defaults to the selected frame." (declare-function x-list-fonts "xfaces.c" (pattern &optional face frame maximum width)) -(defun set-frame-font (font &optional keep-size frames) +(defun set-frame-font (font &optional keep-size frames inhibit-customize) "Set the default font to FONT. When called interactively, prompt for the name of a font, and use that font on the selected frame. When called from Lisp, FONT @@ -1414,7 +1414,10 @@ If FRAMES is non-nil, it should be a list of frames to act upon, or t meaning all existing graphical frames. Also, if FRAMES is non-nil, alter the user's Customization settings as though the font-related attributes of the `default' face had been -\"set in this session\", so that the font is applied to future frames." +\"set in this session\", so that the font is applied to future frames. + +If INHIBIT-CUSTOMIZE is non-nil, don't update the user's +Customization settings." (interactive (let* ((completion-ignore-case t) (default (frame-parameter nil 'font)) @@ -1451,7 +1454,8 @@ as though the font-related attributes of the `default' face had been f (list (cons 'height (round height (frame-char-height f))) (cons 'width (round width (frame-char-width f)))))))) - (when frames + (when (and frames + (not inhibit-customize)) ;; Alter the user's Custom setting of the `default' face, but ;; only for font-related attributes. (let ((specs (cadr (assq 'user (get 'default 'theme-face)))) commit 7ec5a9593d5c71994633ef6f747ac989a8f585e2 Author: Lars Ingebrigtsen Date: Tue Jul 13 20:21:30 2021 +0200 Document the syntax-multilne text property * doc/lispref/modes.texi (Multiline Font Lock): Document the syntax-multiline text property (bug#20436). diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 5869f53636..d271db8e3f 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3575,6 +3575,14 @@ it also handles the case where highlighting depends on subsequent lines. @end itemize +If parsing the syntax of a construct depends on it being parsed in one +single chunk, you can add the @code{syntax-multiline} text property +over the construct in question. The most common use for this is when +the syntax to use for @samp{FOO} depends on some later text +@samp{BAR}: By placing this text property over the whole of +@samp{FOO...BAR}, you make sure that any change of @samp{BAR} will +cause the syntax of @samp{FOO} to be recomputed. + @menu * Font Lock Multiline:: Marking multiline chunks with a text property. * Region to Refontify:: Controlling which region gets refontified commit 35a8861619d4a5038ff37aa9fbeb995bc9b861a7 Author: Juri Linkov Date: Tue Jul 13 22:25:05 2021 +0300 Support Isearch filter predicates with empty search hits (bug#49534) * lisp/isearch.el (isearch-search): Move (= (match-beginning 0) (match-end 0)) and (bobp)/(eobp) outside the call to isearch-filter-predicate. Use forward-char 1/-1 on empty matches only when going to retry search. (isearch-lazy-highlight-search): Remove (= (point) bound), but leave (= (match-beginning 0) (match-end 0)) since empty matches make no sense in lazy-highlighting. diff --git a/lisp/isearch.el b/lisp/isearch.el index c8bd62875f..d1b9f2c439 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3529,11 +3529,14 @@ Optional third argument, if t, means if fail just return nil (no error). ;; Clear RETRY unless the search predicate says ;; to skip this search hit. (if (or (not isearch-success) - (bobp) (eobp) - (= (match-beginning 0) (match-end 0)) (funcall isearch-filter-predicate (match-beginning 0) (match-end 0))) - (setq retry nil))) + (setq retry nil) + ;; Advance point on empty matches before retrying + (when (= (match-beginning 0) (match-end 0)) + (if (if isearch-forward (eobp) (bobp)) + (setq retry nil isearch-success nil) + (forward-char (if isearch-forward 1 -1)))))) (setq isearch-just-started nil) (when isearch-success (setq isearch-other-end @@ -4044,7 +4047,6 @@ Attempt to do the search exactly the way the pending Isearch would." ;; Clear RETRY unless the search predicate says ;; to skip this search hit. (if (or (not success) - (= (point) bound) ; like (bobp) (eobp) in `isearch-search'. (= (match-beginning 0) (match-end 0)) (funcall isearch-filter-predicate (match-beginning 0) (match-end 0))) commit b68e7a64ae624f79538d618afa8f90ae73c26b33 Author: Lars Ingebrigtsen Date: Tue Jul 13 20:13:21 2021 +0200 Make 'tex-validate-buffer' work again * lisp/textmodes/tex-mode.el (tex-validate-buffer): The *Occur* buffer is read-only, so inhibit that before inserting things into it (bug#19326). diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 8b8108cb97..ababd775d5 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1427,7 +1427,9 @@ on the line for the invalidity you want to see." (forward-line 1) (setq num-matches (1+ num-matches)) (insert-buffer-substring buffer start end) - (let (text-beg (text-end (point-marker))) + (let ((text-end (point-marker)) + (inhibit-read-only t) + text-beg) (forward-char (- start end)) (setq text-beg (point-marker)) (insert (format "%3d: " linenum)) @@ -1439,7 +1441,8 @@ on the line for the invalidity you want to see." (put-text-property text-beg (- text-end 1) 'occur-target tem)))))))) (with-current-buffer standard-output - (let ((no-matches (zerop num-matches))) + (let ((no-matches (zerop num-matches)) + (inhibit-read-only t)) (if no-matches (insert "None!\n")) (if (called-interactively-p 'interactive) commit 1e96b97e3c4aa9cf119a7158ae77cf8c2d6c116d Merge: cce84822f7 5afe27624f Author: Michael Albinus Date: Tue Jul 13 19:50:30 2021 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit cce84822f72e6cd4af7bfa351a4da2c9bdc5bb81 Author: Michael Albinus Date: Tue Jul 13 19:50:05 2021 +0200 Add remote-file-name-inhibit-locks * doc/emacs/files.texi (Interlocking): * doc/lispref/files.texi (File Locks): * doc/misc/tramp.texi (Auto-save File Lock and Backup): Add remote-file-name-inhibit-locks. * etc/NEWS: New user option 'remote-file-name-inhibit-locks'. * lisp/files.el (remote-file-name-inhibit-locks): New defcustom. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Use `tramp-handle-make-lock-file-name'. * lisp/net/tramp.el (tramp-allow-unsafe-temporary-files): Fix docstring. (tramp-handle-make-lock-file-name): New defun. * test/lisp/net/tramp-tests.el (tramp-test39-lock-file): Extend test. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 98b6b194d2..32a2f1bb81 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -836,6 +836,10 @@ warning message and asks for confirmation before saving; answer place, one way to compare the buffer to its file is the @kbd{M-x diff-buffer-with-file} command. @xref{Comparing Files}. +@vindex remote-file-name-inhibit-locks + You can prevent the creation of remote lock files by setting the +variable @code{remote-file-name-inhibit-locks} to @code{t}. + @node File Shadowing @subsection Shadowing Files @cindex shadow files diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index b1b70a9f06..1f4049f715 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -821,6 +821,11 @@ If you wish, you can replace the @code{ask-user-about-lock} function with your own version that makes the decision in another way. @end defun +@defopt remote-file-name-inhibit-locks +You can prevent the creation of remote lock files by setting the +variable @code{remote-file-name-inhibit-locks} to @code{t}. +@end defopt + @node Information about Files @section Information about Files @cindex file, information about diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 8ba5f0118a..088352e8a8 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2858,11 +2858,15 @@ to warn you, if a file is changed in parallel from different Emacs sessions, or via different remote connections. Be careful with such settings. +@vindex remote-file-name-inhibit-locks +Setting @code{remote-file-name-inhibit-locks} to non-@code{nil} +prevents the creation of remote lock files at all. + @vindex tramp-allow-unsafe-temporary-files Per default, @value{tramp} asks for confirmation if a -@samp{root}-owned backup or auto-save remote file has to be written to -your local temporary directory. If you want to suppress this -confirmation question, set user option +@samp{root}-owned remote backup, auto-save or lock file has to be +written to your local temporary directory. If you want to suppress +this confirmation question, set user option @code{tramp-allow-unsafe-temporary-files} to @code{t}. diff --git a/etc/NEWS b/etc/NEWS index 923cfcc472..fd661a1e7a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1464,12 +1464,15 @@ buffer to a file under the "/tmp/" directory. This is useful, if (in rare cases) Tramp blocks Emacs, and we need further debug information. +++ -*** Writing sensitive auto-save or backup files to the local temporary -directory must be confirmed. In order to suppress this confirmation, -set user option 'tramp-allow-unsafe-temporary-files' to t. +*** Tramp supports lock files now. +In order to deactivate this, set user option +'remote-file-name-inhibit-locks' to t. +++ -*** Tramp supports file locks now. +*** Writing sensitive auto-save, backup or lock files to the local +temporary directory must be confirmed. In order to suppress this +confirmation, set user option 'tramp-allow-unsafe-temporary-files' to +t. ** Tempo @@ -2182,6 +2185,10 @@ summaries will include the failing condition. This option allows controlling where lock files are written. It uses the same syntax as 'auto-save-file-name-transforms'. ++++ +*** New user option 'remote-file-name-inhibit-locks'. +When non-nil, this option suppresses lock files for remote files. + +++ *** New user option 'kill-transform-function'. This can be used to transform (and suppress) strings from entering the diff --git a/lisp/files.el b/lisp/files.el index 0dfcab8f89..ad02d373fd 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -427,6 +427,12 @@ file it's locking, and it has the same name, but with \".#\" prepended." :initialize 'custom-initialize-delay :version "28.1") +(defcustom remote-file-name-inhibit-locks nil + "Whether to use file locks for remote files." + :group 'files + :version "28.1" + :type 'boolean) + (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.") (defcustom auto-save-visited-interval 5 diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index dbbbfe6a3f..8138d9a360 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -164,7 +164,7 @@ It is used for TCP/IP devices." (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-adb-handle-make-directory) (make-directory-internal . ignore) - ;; `make-lock-file-name' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-adb-handle-make-process) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 1b77fea7e1..109db3b1d7 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -213,7 +213,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-crypt-handle-make-directory) (make-directory-internal . ignore) - ;; `make-lock-file-name' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 04de5defb3..022fdeeb88 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -805,7 +805,7 @@ It has been changed in GVFS 1.14.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-gvfs-handle-make-directory) (make-directory-internal . ignore) - ;; `make-lock-file-name' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 473fa8a8f0..49e366c01c 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -127,7 +127,7 @@ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-fuse-handle-make-directory) (make-directory-internal . ignore) - ;; `make-lock-file-name' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3595bd2655..760320d7ed 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -993,7 +993,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sh-handle-make-directory) ;; `make-directory-internal' performed by default handler. - ;; `make-lock-file-name' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-sh-handle-make-process) (make-symbolic-link . tramp-sh-handle-make-symbolic-link) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 1c7ddee008..4008c25d3a 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -278,7 +278,7 @@ See `tramp-actions-before-shell' for more info.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-smb-handle-make-directory) (make-directory-internal . tramp-smb-handle-make-directory-internal) - ;; `make-lock-file-name' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-smb-handle-make-symbolic-link) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 5f6807a0db..99f4063988 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -127,7 +127,7 @@ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-fuse-handle-make-directory) (make-directory-internal . ignore) - ;; `make-lock-file-name' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-handle-make-process) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index d68a5c1adf..45d9fab986 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -120,7 +120,7 @@ See `tramp-actions-before-shell' for more info.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sudoedit-handle-make-directory) (make-directory-internal . ignore) - ;; `make-lock-file-name' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9e6bfceb49..3f586c6217 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3630,7 +3630,7 @@ User is always nil." (file-writable-p (file-name-directory filename))))))) (defcustom tramp-allow-unsafe-temporary-files nil - "Whether root-owned auto-save or backup files can be written to \"/tmp\"." + "Whether root-owned auto-save, backup or lock files can be written to \"/tmp\"." :version "28.1" :type 'boolean) @@ -3880,6 +3880,30 @@ Return nil when there is no lockfile." (write-region info nil lockname) (set-file-modes lockname #o0644)))))))) +(defun tramp-handle-make-lock-file-name (file) + "Like `make-lock-file-name' for Tramp files." + (when (and create-lockfiles + ;; This variable has been introduced with Emacs 28.1. + (not (bound-and-true-p remote-file-name-inhibit-locks))) + (with-parsed-tramp-file-name file nil + (let ((result + ;; Run plain `make-lock-file-name'. + (tramp-run-real-handler #'make-lock-file-name (list file)))) + ;; Protect against security hole. + (when (and (not tramp-allow-unsafe-temporary-files) + (file-in-directory-p result temporary-file-directory) + (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes file 'integer)) + tramp-unknown-id-integer)) + (not (with-tramp-connection-property + (tramp-get-process v) "unsafe-temporary-file" + (yes-or-no-p + (concat + "Lock file on local temporary directory, " + "do you want to continue? "))))) + (tramp-error v 'file-error "Unsafe lock file name")) + result)))) + (defun tramp-handle-unlock-file (file) "Like `unlock-file' for Tramp files." (when-let ((lockname (tramp-compat-make-lock-file-name file))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 44fd1b45b2..bc05db8095 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5751,8 +5751,10 @@ Use direct async.") (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) - (let ((tmp-name (tramp--test-make-temp-name nil quoted)) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) (remote-file-name-inhibit-cache t) + (remote-file-name-inhibit-locks nil) (create-lockfiles t) (inhibit-message t) ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files. @@ -5765,51 +5767,73 @@ Use direct async.") (unwind-protect (progn ;; A simple file lock. - (should-not (file-locked-p tmp-name)) - (lock-file tmp-name) - (should (eq (file-locked-p tmp-name) t)) + (should-not (file-locked-p tmp-name1)) + (lock-file tmp-name1) + (should (eq (file-locked-p tmp-name1) t)) ;; If it is locked already, nothing changes. - (lock-file tmp-name) - (should (eq (file-locked-p tmp-name) t)) + (lock-file tmp-name1) + (should (eq (file-locked-p tmp-name1) t)) ;; A new connection changes process id, and also the ;; lockname contents. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (stringp (file-locked-p tmp-name))) + (should (stringp (file-locked-p tmp-name1))) + + ;; When `remote-file-name-inhibit-locks' is set, nothing happens. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (let ((remote-file-name-inhibit-locks t)) + (lock-file tmp-name1) + (should-not (file-locked-p tmp-name1))) + + ;; When `lock-file-name-transforms' is set, another lock + ;; file is used. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (let ((lock-file-name-transforms `((".*" ,tmp-name2)))) + (should + (string-equal + (make-lock-file-name tmp-name1) + (make-lock-file-name tmp-name2))) + (lock-file tmp-name1) + (should (eq (file-locked-p tmp-name1) t)) + (unlock-file tmp-name1) + (should-not (file-locked-p tmp-name1))) ;; Steal the file lock. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s))) - (lock-file tmp-name)) - (should (eq (file-locked-p tmp-name) t)) + (lock-file tmp-name1)) + (should (eq (file-locked-p tmp-name1) t)) ;; Ignore the file lock. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p))) - (lock-file tmp-name)) - (should (stringp (file-locked-p tmp-name))) + (lock-file tmp-name1)) + (should (stringp (file-locked-p tmp-name1))) ;; Quit the file lock machinery. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) - (should-error (lock-file tmp-name) :type 'file-locked) + (should-error (lock-file tmp-name1) :type 'file-locked) ;; The same for `write-region'. - (should-error (write-region "foo" nil tmp-name) :type 'file-locked) (should-error - (write-region "foo" nil tmp-name nil nil tmp-name) + (write-region "foo" nil tmp-name1) :type 'file-locked) + (should-error + (write-region "foo" nil tmp-name1 nil nil tmp-name1) :type 'file-locked) ;; The same for `set-visited-file-name'. (with-temp-buffer (should-error - (set-visited-file-name tmp-name) :type 'file-locked))) - (should (stringp (file-locked-p tmp-name))) - (should-not (file-exists-p tmp-name))) + (set-visited-file-name tmp-name1) :type 'file-locked))) + (should (stringp (file-locked-p tmp-name1))) + (should-not (file-exists-p tmp-name1))) ;; Cleanup. - (ignore-errors (delete-file tmp-name)) - (unlock-file tmp-name) - (should-not (file-locked-p tmp-name)))))) + (ignore-errors (delete-file tmp-name1)) + (unlock-file tmp-name1) + (unlock-file tmp-name2) + (should-not (file-locked-p tmp-name1)) + (should-not (file-locked-p tmp-name2)))))) ;; The functions were introduced in Emacs 26.1. (ert-deftest tramp-test40-make-nearby-temp-file () commit 5afe27624f7168713611dc9c24043091f8f820b6 Author: Lars Ingebrigtsen Date: Tue Jul 13 19:49:50 2021 +0200 Add new user option to avoid piling on Dired buffers * doc/emacs/dired.texi (Dired Visiting): Document it. * lisp/dired.el (dired-kill-when-opening-new-dired-buffer): New user option (bug#20598). (dired-up-directory, dired-find-file): Use it. (dired--find-possibly-alternative-file): New convenience command to respect the user option. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 36257030c8..3fbaf8bab7 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -457,6 +457,15 @@ Visit the parent directory of the current directory for @file{..} and typing @kbd{f} there. @end table +@defopt dired-kill-when-opening-new-dired-buffer + When visiting a new sub-directory in Dired, Emacs will (by default) +open a new buffer to display this new directory, and leave the old +Dired buffer as is. If this user option is non-@code{nil}, the old +Dired buffer will be killed after selecting the new directory. This +means that if you're traversing a directory structure in Dired, you +won't end up with more than a single Dired buffer. +@end defopt + @node Marks vs Flags @section Dired Marks vs.@: Flags diff --git a/etc/NEWS b/etc/NEWS index 923cfcc472..75be112fd3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -778,6 +778,11 @@ time zones will use a form like "+0100" instead of "CET". ** Dired ++++ +*** New user option 'dired-kill-when-opening-new-dired-buffer'. +If non-nil, Dired will kill the current buffer when selecting a new +directory to display. + --- *** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'. Previously, if 'dired-clean-up-buffers-too' was non-nil, and diff --git a/lisp/dired.el b/lisp/dired.el index fb353a92e4..da803feaa1 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -356,6 +356,11 @@ is anywhere on its Dired line, except the beginning of the line." :group 'dired :version "28.1") +(defcustom dired-kill-when-opening-new-dired-buffer nil + "If non-nil, kill the current buffer when selecting a new directory." + :type 'boolean + :version "28.1") + ;;; Internal variables @@ -2379,7 +2384,7 @@ directory in another window." (progn (if other-window (dired-other-window up) - (dired up)) + (dired--find-possibly-alternative-file up)) (dired-goto-file dir))))) (defun dired-get-file-for-visit () @@ -2403,7 +2408,16 @@ directory in another window." (defun dired-find-file () "In Dired, visit the file or directory named on this line." (interactive) - (dired--find-file #'find-file (dired-get-file-for-visit))) + (dired--find-possibly-alternative-file (dired-get-file-for-visit))) + +(defun dired--find-possibly-alternative-file (file) + "Find FILE, but respect `dired-kill-when-opening-new-dired-buffer'." + (if (and dired-kill-when-opening-new-dired-buffer + (file-directory-p file)) + (progn + (set-buffer-modified-p nil) + (dired--find-file #'find-alternate-file file)) + (dired--find-file #'find-file file))) (defun dired--find-file (find-file-function file) "Call FIND-FILE-FUNCTION on FILE, but bind some relevant variables." commit 7a803ecd3d455999cfc9266fa219d58109fac786 Author: Mattias Engdegård Date: Mon Jul 12 13:58:28 2021 +0200 Block TLS handshake until TCP connection established If a TLS handshake is attempted before the completion of an asynchronous TCP connection has been ascertained, our local state will not be set up correctly for further progress and the sentinel "open" event will never be sent. This can occur if sufficient time passes after the initiation of an async TCP connection so that by the time `wait_reading_process_output` is called, the connection has already been established on the TCP level. This somewhat timing-sensitive bug has plagued HTTPS connections on some platforms, notably macOS, for a long time (bug#49449). * src/process.c (wait_reading_process_output): Gate the TLS handshake by the NON_BLOCKING_CONNECT_FD flag. The flag will be cleared as soon as the TCP socket is found to be writable. * test/src/process-tests.el (process-async-https-with-delay): New test. diff --git a/src/process.c b/src/process.c index b8c3e4ecfb..c3186eed75 100644 --- a/src/process.c +++ b/src/process.c @@ -5232,7 +5232,10 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, #ifdef HAVE_GNUTLS /* Continue TLS negotiation. */ if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED - && p->is_non_blocking_client) + && p->is_non_blocking_client + /* Don't proceed until we have established a connection. */ + && !(fd_callback_info[p->outfd].flags + & NON_BLOCKING_CONNECT_FD)) { gnutls_try_handshake (p); p->gnutls_handshakes_tried++; diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 1774f2fc74..9bab523708 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -28,6 +28,7 @@ (require 'puny) (require 'subr-x) (require 'dns) +(require 'url-http) ;; Timeout in seconds; the test fails if the timeout is reached. (defvar process-test-sentinel-wait-timeout 2.0) @@ -916,5 +917,34 @@ Return nil if FILENAME doesn't exist." ;; ...and the change description should be "interrupt". (should (equal '("interrupt\n") events))))) +(ert-deftest process-async-https-with-delay () + "Bug#49449: asynchronous TLS connection with delayed completion." + (skip-unless (and internet-is-working (gnutls-available-p))) + (let* ((status nil) + (buf (url-http + #s(url "https" nil nil "elpa.gnu.org" nil + "/packages/archive-contents" nil nil t silent t t) + (lambda (s) (setq status s)) + '(nil) nil 'tls))) + (unwind-protect + (progn + ;; Busy-wait for 1 s to allow for the TCP connection to complete. + (let ((delay 1.0) + (t0 (float-time))) + (while (< (float-time) (+ t0 delay)))) + ;; Wait for the entire operation to finish. + (let ((limit 4.0) + (t0 (float-time))) + (while (and (null status) + (< (float-time) (+ t0 limit))) + (sit-for 0.1))) + (should status) + (should-not (assq :error status)) + (should buf) + (should (> (buffer-size buf) 0)) + ) + (when buf + (kill-buffer buf))))) + (provide 'process-tests) ;;; process-tests.el ends here commit a41f585bf111b239601ca7d915994fed600852af Author: Ken Brown Date: Mon Jul 12 09:24:12 2021 -0400 Fix portability issue with make-serial-process * src/sysdep.c (struct speed_struct): New struct. (speeds): New static array of struct speed_struct. (convert_speed): New static function to convert a numerical baud rate (e.g., 9600) to a Bnnn constant defined in termios.h (e.g., B9600). (serial_configure): Use convert_speed to make the call to cfsetspeed compliant with its advertised API. (Bug#49524) diff --git a/src/sysdep.c b/src/sysdep.c index b8ec22d9dd..8eaee22498 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2744,6 +2744,138 @@ cfsetspeed (struct termios *termios_p, speed_t vitesse) } #endif +/* The following is based on the glibc implementation of cfsetspeed. */ + +struct speed_struct +{ + speed_t value; + speed_t internal; +}; + +static const struct speed_struct speeds[] = + { +#ifdef B0 + { 0, B0 }, +#endif +#ifdef B50 + { 50, B50 }, +#endif +#ifdef B75 + { 75, B75 }, +#endif +#ifdef B110 + { 110, B110 }, +#endif +#ifdef B134 + { 134, B134 }, +#endif +#ifdef B150 + { 150, B150 }, +#endif +#ifdef B200 + { 200, B200 }, +#endif +#ifdef B300 + { 300, B300 }, +#endif +#ifdef B600 + { 600, B600 }, +#endif +#ifdef B1200 + { 1200, B1200 }, +#endif +#ifdef B1200 + { 1200, B1200 }, +#endif +#ifdef B1800 + { 1800, B1800 }, +#endif +#ifdef B2400 + { 2400, B2400 }, +#endif +#ifdef B4800 + { 4800, B4800 }, +#endif +#ifdef B9600 + { 9600, B9600 }, +#endif +#ifdef B19200 + { 19200, B19200 }, +#endif +#ifdef B38400 + { 38400, B38400 }, +#endif +#ifdef B57600 + { 57600, B57600 }, +#endif +#ifdef B76800 + { 76800, B76800 }, +#endif +#ifdef B115200 + { 115200, B115200 }, +#endif +#ifdef B153600 + { 153600, B153600 }, +#endif +#ifdef B230400 + { 230400, B230400 }, +#endif +#ifdef B307200 + { 307200, B307200 }, +#endif +#ifdef B460800 + { 460800, B460800 }, +#endif +#ifdef B500000 + { 500000, B500000 }, +#endif +#ifdef B576000 + { 576000, B576000 }, +#endif +#ifdef B921600 + { 921600, B921600 }, +#endif +#ifdef B1000000 + { 1000000, B1000000 }, +#endif +#ifdef B1152000 + { 1152000, B1152000 }, +#endif +#ifdef B1500000 + { 1500000, B1500000 }, +#endif +#ifdef B2000000 + { 2000000, B2000000 }, +#endif +#ifdef B2500000 + { 2500000, B2500000 }, +#endif +#ifdef B3000000 + { 3000000, B3000000 }, +#endif +#ifdef B3500000 + { 3500000, B3500000 }, +#endif +#ifdef B4000000 + { 4000000, B4000000 }, +#endif + }; + +/* Convert a numerical speed (e.g., 9600) to a Bnnn constant (e.g., + B9600); see bug#49524. */ +static speed_t +convert_speed (speed_t speed) +{ + for (size_t i = 0; i < sizeof speeds / sizeof speeds[0]; i++) + { + if (speed == speeds[i].internal) + return speed; + else if (speed == speeds[i].value) + return speeds[i].internal; + } + return speed; +} + /* For serial-process-configure */ void serial_configure (struct Lisp_Process *p, @@ -2775,7 +2907,7 @@ serial_configure (struct Lisp_Process *p, else tem = Fplist_get (p->childp, QCspeed); CHECK_FIXNUM (tem); - err = cfsetspeed (&attr, XFIXNUM (tem)); + err = cfsetspeed (&attr, convert_speed (XFIXNUM (tem))); if (err != 0) report_file_error ("Failed cfsetspeed", tem); childp2 = Fplist_put (childp2, QCspeed, tem); commit 0d9e1826f7420cd49ca1162e56950ea7f8b4d449 Author: Eli Zaretskii Date: Tue Jul 13 15:03:59 2021 +0300 One more minor update of the Emacs manual for 19th printing * doc/emacs/back.texi: * doc/emacs/book-spine.texi: * doc/emacs/emacs.texi: Last round of minor copyedits for 19th ed. diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi index 549e0e925e..ae0121e1a8 100644 --- a/doc/emacs/back.texi +++ b/doc/emacs/back.texi @@ -15,8 +15,8 @@ @sp 1 @quotation -GNU Emacs is much @strong{more than a text editor}; over the years, it -has expanded to become @strong{an entire workflow environment}, +GNU Emacs is much @strong{more than a text editor;} over the years, it +has expanded to become @strong{an entire workflow environment,} impressing programmers with its integrated debugging and project-management features. It is also a multi-lingual word processor, can handle all your email and Usenet news needs, display @@ -26,7 +26,7 @@ Features include: @itemize @bullet @item -Special editing modes for @strong{27 programming languages}, including C, +Special editing modes for @strong{27 programming languages,} including C, C@t{++}, Fortran, Java, JavaScript, Lisp, Objective C, Pascal, Perl, and Scheme. @@ -36,7 +36,7 @@ and creating Makefiles for GNU/Linux, UNIX, Windows/DOS, and VMS systems. @item -Support for typing and displaying in @strong{60 non-English languages}, +Support for typing and displaying in @strong{60 non-English languages,} including Arabic, Chinese, Czech, Hebrew, Hindi, Japanese, Korean, Russian, Vietnamese, and all Western European languages. @@ -52,7 +52,7 @@ editing modes for @LaTeX{} and @TeX{} are included). @strong{Compile} and @strong{debug} from inside Emacs. @item -Maintain program @strong{ChangeLogs}. +Maintain program @strong{ChangeLogs.} @item Flag, move, and delete files and sub-directories recursively @@ -74,26 +74,25 @@ And much more! @end itemize @end itemize -And when you tire of all the work you can accomplish with it, Emacs -contains games to play. - Emacs comes with an introductory online tutorial available in many -languages, and this manual picks up where that tutorial ends. It -explains the full range of the power of Emacs, now up to @strong{version -27.2}, and contains reference material useful to expert users. It -also includes appendices with specific material about X and GTK -resources, and with details for users of macOS and Microsoft Windows. +languages, and this nineteenth edition of the manual picks up where +that tutorial ends. It explains the full range of the power of Emacs, +now up to @strong[version 27.2,} and contains reference material +useful to expert users. It also includes appendices with specific +material about X and GTK resources, and with details for users of +macOS and Microsoft Windows. -Appendices are included, with specific material about X and GTK -resources, and with details for users of Macintosh and Microsoft OS. +And when you tire of all the work you can accomplish with it, Emacs +contains games to play. -@strong{About the original and principal Author:} +@strong{About the original and principal author:} -Richard M.@: Stallman developed the first Emacs in 1975 and wrote GNU +Richard M.@: Stallman developed the first Emacs in 1976 and wrote GNU Emacs in 1984/85. He has received the ACM Grace Hopper Award, a MacArthur Foundation fellowship, the Electronic Frontier Foundation's -Pioneer award, and the Takeda Award for Social/Economic Betterment, as -well as several honorary doctorates. +Pioneer award, the Takeda Award for Social/Economic Betterment, and +the ACM Software and System Award, as well as several doctorates +honoris causa. @end quotation @hfil diff --git a/doc/emacs/book-spine.texi b/doc/emacs/book-spine.texi index 17fccee135..20e23ca2bf 100644 --- a/doc/emacs/book-spine.texi +++ b/doc/emacs/book-spine.texi @@ -13,7 +13,7 @@ @center @titlefont{GNU Emacs Manual} @sp 5 -@center @value{EDITION} Edition, for Emacs Version @value{EMACSVER} +@center @value{EDITION} edition, for Emacs Version @value{EMACSVER} @sp 5 @center by Richard M.@: Stallman et al. diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index b355146ee8..4ef3690688 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -95,7 +95,7 @@ Boston, MA 02110-1301 USA @* ISBN 978-0-9831592-8-5 @sp 2 -Cover art by Etienne Suvasa; cover design by Matt Lee. +Cover art by Etienne Suvasa; cover design by FSF staff. @end titlepage commit d672d576ff6c3ac3c7ee1fa4db13c7e0a4974aa3 Author: Basil L. Contovounesios Date: Mon Jul 12 15:02:14 2021 +0100 ; * doc/lispref/intro.texi (Caveats): Fix paren. diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 35f852b7e4..c2ed96472b 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -89,7 +89,7 @@ you are criticizing. @cindex suggestions Please send comments and corrections using @kbd{M-x report-emacs-bug}. If you wish to contribute new code (or send a -patch to fix a problem), use @kbd{M-x submit-emacs-patch}). +patch to fix a problem), use @kbd{M-x submit-emacs-patch}. @node Lisp History @section Lisp History commit bfd159539f112785ed215cfd2abb2e2e1f2ea1f6 Author: Michael Albinus Date: Mon Jul 12 15:49:50 2021 +0200 Fix a problem with tramp-*-process-file * lisp/net/tramp-adb.el (tramp-adb-handle-process-file): * lisp/net/tramp-sh.el (tramp-sh-handle-process-file): * lisp/net/tramp-smb.el (tramp-smb-handle-process-file): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file): Use `(expand-file-name default-directory)'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 63fd5eb06a..dbbbfe6a3f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -803,7 +803,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when (and (numberp destination) (zerop destination)) (error "Implementation does not handle immediate return")) - (with-parsed-tramp-file-name default-directory nil + (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let (command input tmpinput stderr tmpstderr outbuf ret) ;; Compute command. (setq command (mapconcat #'tramp-shell-quote-argument diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e5929bd366..3595bd2655 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3029,7 +3029,7 @@ implementation will be used." (when (and (numberp destination) (zerop destination)) (error "Implementation does not handle immediate return")) - (with-parsed-tramp-file-name default-directory nil + (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let (command env uenv input tmpinput stderr tmpstderr outbuf ret) ;; Compute command. (setq command (mapconcat #'tramp-shell-quote-argument diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index d3de0455dd..1c7ddee008 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1259,7 +1259,7 @@ component is used as the target of the symlink." (when (and (numberp destination) (zerop destination)) (error "Implementation does not handle immediate return")) - (with-parsed-tramp-file-name default-directory nil + (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let* ((name (file-name-nondirectory program)) (name1 name) (i 0) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index f4872cef10..5f6807a0db 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -235,7 +235,7 @@ arguments to pass to the OPERATION." (when (and (numberp destination) (zerop destination)) (error "Implementation does not handle immediate return")) - (with-parsed-tramp-file-name default-directory nil + (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let ((command (format "cd %s && exec %s" commit a79c578f3d77101964b837e8fa8b8109f21c7a88 Author: Paul Eggert Date: Mon Jul 12 00:11:22 2021 -0700 Port test module to glibc 2.33 * test/Makefile.in (REPLACE_FREE, FREE_SOURCE_0, FREE_SOURCE_1): New macros. ($(test_module)): Improve accuracy of test as to whether free.c should be compiled; glibc 2.33 does not need it compiled and the compilation breaks if you try, if you build with --enable-gcc-warnings. diff --git a/test/Makefile.in b/test/Makefile.in index c1518d3dcd..7047c24482 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -49,6 +49,8 @@ SEPCHAR = @SEPCHAR@ HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@ +REPLACE_FREE = @REPLACE_FREE@ + -include ${top_builddir}/src/verbose.mk # Load any GNU ELPA dependencies that are present, for optional tests. @@ -274,6 +276,9 @@ MODULE_CFLAGS = -I../src -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib \ test_module = $(test_module_dir)/mod-test${SO} src/emacs-module-tests.log src/emacs-module-tests.elc: $(test_module) +FREE_SOURCE_0 = +FREE_SOURCE_1 = $(srcdir)/../lib/free.c + # In the compilation command, we can't use any object or archive file # as source because those are not compiled with -fPIC. Therefore we # use only source files. @@ -282,7 +287,7 @@ $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h $(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \ -o $@ $< $(LIBGMP) \ $(and $(GMP_H),$(srcdir)/../lib/mini-gmp-gnulib.c) \ - $(if $(OMIT_GNULIB_MODULE_free-posix),,$(srcdir)/../lib/free.c) \ + $(FREE_SOURCE_$(REPLACE_FREE)) \ $(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c endif commit c22cf4d02ff7ebd85839aac5336f6e279f32db54 Author: Paul Eggert Date: Mon Jul 12 00:07:38 2021 -0700 Pacify gcc 11.1.1 -Wclobbered * src/eval.c (Fprogn, internal_lisp_condition_case): Add CACHEABLE to work around more instances of -Wclobbered bug. diff --git a/src/eval.c b/src/eval.c index 18faa0b9b1..b76ced79d6 100644 --- a/src/eval.c +++ b/src/eval.c @@ -462,7 +462,7 @@ DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, usage: (progn BODY...) */) (Lisp_Object body) { - Lisp_Object val = Qnil; + Lisp_Object CACHEABLE val = Qnil; while (CONSP (body)) { @@ -1429,7 +1429,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, } } - Lisp_Object result = eval_sub (bodyform); + Lisp_Object CACHEABLE result = eval_sub (bodyform); handlerlist = oldhandlerlist; if (!NILP (success_handler)) { commit 1a0fe2a5184cd4c57972994cf4b688042aecc534 Author: Paul Eggert Date: Mon Jul 12 00:06:34 2021 -0700 Pacify gcc 11.1.1 -Wanalyzer-possible-null-dereference * oldXMenu/Create.c (XMenuCreate): * oldXMenu/Internal.c (_XMRecomputePane, _XMRecomputeSelection): * oldXMenu/XMakeAssoc.c (XMakeAssoc): * test/src/emacs-module-resources/mod-test.c (Fmod_test_userptr_make): Don’t assume that malloc and calloc succeed. diff --git a/oldXMenu/Create.c b/oldXMenu/Create.c index 7eb17c508d..e209bbecee 100644 --- a/oldXMenu/Create.c +++ b/oldXMenu/Create.c @@ -598,6 +598,8 @@ XMenuCreate(Display *display, Window parent, register char const *def_env) * Create pane, active, and inactive GC's. */ values = (XGCValues *)malloc(sizeof(XGCValues)); + if (!values) + return NULL; valuemask = (GCForeground | GCBackground | GCFont | GCLineWidth); /* diff --git a/oldXMenu/Internal.c b/oldXMenu/Internal.c index f489e27bea..3e97f9ab3f 100644 --- a/oldXMenu/Internal.c +++ b/oldXMenu/Internal.c @@ -534,7 +534,6 @@ _XMRecomputePane(register Display *display, register XMenu *menu, register XMPan register int window_y; /* Recomputed window Y coordinate. */ unsigned long change_mask; /* Value mask to reconfigure window. */ - XWindowChanges *changes; /* Values to use in configure window. */ register Bool config_p = False; /* Reconfigure pane window? */ @@ -612,21 +611,19 @@ _XMRecomputePane(register Display *display, register XMenu *menu, register XMPan * it for creation with the new configuration. */ if (p_ptr->window) { + XWindowChanges changes; change_mask = (CWX | CWY | CWWidth | CWHeight); - changes = (XWindowChanges *)malloc(sizeof(XWindowChanges)); - changes->x = p_ptr->window_x; - changes->y = p_ptr->window_y; - changes->width = p_ptr->window_w; - changes->height = p_ptr->window_h; + changes.x = p_ptr->window_x; + changes.y = p_ptr->window_y; + changes.width = p_ptr->window_w; + changes.height = p_ptr->window_h; XConfigureWindow( display, p_ptr->window, change_mask, - changes + &changes ); - free(changes); - } else { if (_XMWinQueAddPane(display, menu, p_ptr) == _FAILURE) { @@ -681,7 +678,6 @@ _XMRecomputeSelection(register Display *display, register XMenu *menu, register /* Selection sequence number. */ { register Bool config_s = False; /* Reconfigure selection window? */ - XWindowChanges *changes; /* Values to change in configure. */ unsigned long change_mask; /* Value mask for XConfigureWindow. */ /* @@ -738,22 +734,19 @@ _XMRecomputeSelection(register Display *display, register XMenu *menu, register * for creation with the new configuration. */ if (s_ptr->window) { - changes = (XWindowChanges *)malloc(sizeof(XWindowChanges)); + XWindowChanges changes; change_mask = (CWX | CWY | CWWidth | CWHeight); - changes = (XWindowChanges *)malloc(sizeof(XWindowChanges)); - changes->x = s_ptr->window_x; - changes->y = s_ptr->window_y; - changes->width = s_ptr->window_w; - changes->height = s_ptr->window_h; + changes.x = s_ptr->window_x; + changes.y = s_ptr->window_y; + changes.width = s_ptr->window_w; + changes.height = s_ptr->window_h; XConfigureWindow( display, s_ptr->window, change_mask, - changes + &changes ); - free(changes); - } else { if (_XMWinQueAddSelection(display, menu, s_ptr) == _FAILURE) { diff --git a/oldXMenu/XMakeAssoc.c b/oldXMenu/XMakeAssoc.c index 9bbde2cf94..2530e8e507 100644 --- a/oldXMenu/XMakeAssoc.c +++ b/oldXMenu/XMakeAssoc.c @@ -69,6 +69,8 @@ XMakeAssoc(register Display *dpy, register XAssocTable *table, register XID x_id /* before the current value of "Entry". */ /* Create a new XAssoc and load it with new provided data. */ new_entry = (XAssoc *) malloc(sizeof(XAssoc)); + if (!new_entry) + return; /* This obsolete API has no way to report failure! */ new_entry->display = dpy; new_entry->x_id = x_id; new_entry->data = data; diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index ad59cfc18c..5720af8c60 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -288,6 +288,8 @@ struct super_struct char large_unused_buffer[512]; }; +static void signal_errno (emacs_env *, char const *); + /* Return a new user-pointer to a super_struct, with amazing_int set to the passed parameter. */ static emacs_value @@ -295,6 +297,8 @@ Fmod_test_userptr_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) { struct super_struct *p = calloc (1, sizeof *p); + if (!p) + signal_errno (env, "calloc"); p->amazing_int = env->extract_integer (env, args[0]); return env->make_user_ptr (env, free, p); } commit 2337869fbf8b967eb53ee57f978f3751987e43dc Author: Paul Eggert Date: Mon Jul 12 00:00:20 2021 -0700 Pacify gcc 11.1.1 -Wanalyzer-null-argument * lib-src/etags.c (regexp): Omit member force_explicit_name, since it’s always true. All uses removed. This lets us remove calls to strlen (name) where GCC isn’t smart enough to deduce that name must be nonnull. * lib-src/movemail.c (main): Fix bug that could cause link (tempname, NULL) to be called. * src/emacs.c (argmatch): Break check into two ‘if’s, since GCC doesn’t seem to be smart enough to check the single ‘if’. * src/gtkutil.c (xg_update_menu_item): Fix bug where strcmp could be given a NULL arg. * src/xfont.c (xfont_list_family): Use nonnull value for dummy initial value. diff --git a/lib-src/etags.c b/lib-src/etags.c index c39c93db33..88b49f803e 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -340,7 +340,6 @@ typedef struct regexp struct re_pattern_buffer *pat; /* the compiled pattern */ struct re_registers regs; /* re registers */ bool error_signaled; /* already signaled for this regexp */ - bool force_explicit_name; /* do not allow implicit tag name */ bool ignore_case; /* ignore case when matching */ bool multi_line; /* do a multi-line match on the whole file */ } regexp; @@ -6910,7 +6909,6 @@ add_regex (char *regexp_pattern, language *lang) struct re_pattern_buffer *patbuf; regexp *rp; bool - force_explicit_name = true, /* do not use implicit tag names */ ignore_case = false, /* case is significant */ multi_line = false, /* matches are done one line at a time */ single_line = false; /* dot does not match newline */ @@ -6949,7 +6947,8 @@ add_regex (char *regexp_pattern, language *lang) case 'N': if (modifiers == name) error ("forcing explicit tag name but no name, ignoring"); - force_explicit_name = true; + /* This option has no effect and is present only for backward + compatibility. */ break; case 'i': ignore_case = true; @@ -7004,7 +7003,6 @@ add_regex (char *regexp_pattern, language *lang) p_head->pat = patbuf; p_head->name = savestr (name); p_head->error_signaled = false; - p_head->force_explicit_name = force_explicit_name; p_head->ignore_case = ignore_case; p_head->multi_line = multi_line; } @@ -7144,20 +7142,15 @@ regex_tag_multiline (void) name = NULL; else /* make a named tag */ name = substitute (buffer, rp->name, &rp->regs); - if (rp->force_explicit_name) - { - /* Force explicit tag name, if a name is there. */ - pfnote (name, true, buffer + linecharno, - charno - linecharno + 1, lineno, linecharno); - - if (debug) - fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n", - name ? name : "(unnamed)", curfdp->taggedfname, - lineno, buffer + linecharno); - } - else - make_tag (name, strlen (name), true, buffer + linecharno, - charno - linecharno + 1, lineno, linecharno); + + /* Force explicit tag name, if a name is there. */ + pfnote (name, true, buffer + linecharno, + charno - linecharno + 1, lineno, linecharno); + + if (debug) + fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n", + name ? name : "(unnamed)", curfdp->taggedfname, + lineno, buffer + linecharno); break; } } @@ -7471,18 +7464,14 @@ readline (linebuffer *lbp, FILE *stream) name = NULL; else /* make a named tag */ name = substitute (lbp->buffer, rp->name, &rp->regs); - if (rp->force_explicit_name) - { - /* Force explicit tag name, if a name is there. */ - pfnote (name, true, lbp->buffer, match, lineno, linecharno); - if (debug) - fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n", - name ? name : "(unnamed)", curfdp->taggedfname, - lineno, lbp->buffer); - } - else - make_tag (name, strlen (name), true, - lbp->buffer, match, lineno, linecharno); + + /* Force explicit tag name, if a name is there. */ + pfnote (name, true, lbp->buffer, match, lineno, linecharno); + + if (debug) + fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n", + name ? name : "(unnamed)", curfdp->taggedfname, + lineno, lbp->buffer); break; } } diff --git a/lib-src/movemail.c b/lib-src/movemail.c index cfdebccb8d..e683da179d 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -270,6 +270,7 @@ main (int argc, char **argv) You might also wish to verify that your system is one which uses lock files for this purpose. Some systems use other methods. */ + bool lockname_unlinked = false; inname_len = strlen (inname); lockname = xmalloc (inname_len + sizeof ".lock"); strcpy (lockname, inname); @@ -312,15 +313,10 @@ main (int argc, char **argv) Five minutes should be good enough to cope with crashes and wedgitude, and long enough to avoid being fooled by time differences between machines. */ - if (stat (lockname, &st) >= 0) - { - time_t now = time (0); - if (st.st_ctime < now - 300) - { - unlink (lockname); - lockname = 0; - } - } + if (!lockname_unlinked + && stat (lockname, &st) == 0 + && st.st_ctime < time (0) - 300) + lockname_unlinked = unlink (lockname) == 0 || errno == ENOENT; } delete_lockname = lockname; diff --git a/src/emacs.c b/src/emacs.c index b7982ece64..866e43fda9 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -670,7 +670,9 @@ argmatch (char **argv, int argc, const char *sstr, const char *lstr, } arglen = (valptr != NULL && (p = strchr (arg, '=')) != NULL ? p - arg : strlen (arg)); - if (lstr == 0 || arglen < minlen || strncmp (arg, lstr, arglen) != 0) + if (!lstr) + return 0; + if (arglen < minlen || strncmp (arg, lstr, arglen) != 0) return 0; else if (valptr == NULL) { diff --git a/src/gtkutil.c b/src/gtkutil.c index dee2a93089..313cfc82c2 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -3221,7 +3221,7 @@ xg_update_menu_item (widget_value *val, gtk_label_set_text (wkey, utf8_key); } - if (! old_label || strcmp (utf8_label, old_label) != 0) + if (utf8_label && (! old_label || strcmp (utf8_label, old_label) != 0)) { label_changed = true; gtk_label_set_text (wlbl, utf8_label); diff --git a/src/xfont.c b/src/xfont.c index 0570ee96a9..81d356175a 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -596,7 +596,10 @@ xfont_list_family (struct frame *f) char **names; int num_fonts, i; Lisp_Object list; - char *last_family UNINIT; + char const *last_family; +#if defined GCC_LINT || defined lint + last_family = ""; +#endif int last_len; block_input (); commit da2f772fe575b20bff51b49aa5ded2bf15a2c89d Author: Paul Eggert Date: Sun Jul 11 23:54:32 2021 -0700 Pacify gcc -Woverflow more nicely * src/alloc.c (mark_maybe_pointer): Simplify pacification of gcc -Woverflow (unknown GCC version). diff --git a/src/alloc.c b/src/alloc.c index e3b038c51c..ee3fd64a00 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4764,12 +4764,7 @@ mark_maybe_pointer (void *p, bool symbol_only) from Emacs source code, it can occur in some cases. To fix this problem, the pdumper code should grok non-initial addresses, as the non-pdumper code does. */ -#ifdef WIDE_EMACS_INT - uintptr_t mask = ~((uintptr_t) 0); -#else - uintptr_t mask = VALMASK; -#endif - void *po = (void *) ((uintptr_t) p & mask); + void *po = (void *) ((uintptr_t) p & (uintptr_t) VALMASK); char *cp = p; char *cpo = po; /* Don't use pdumper_object_p_precise here! It doesn't check the commit 352baac72fd4ab1050c66cd4b27ab54acc051e50 Author: Juri Linkov Date: Mon Jul 12 02:45:51 2021 +0300 * lisp/textmodes/enriched.el: Require 'facemenu' (bug#49466) diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index ba8fac81f2..877658a5a5 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -38,7 +38,7 @@ ;;; Code: -(provide 'enriched) +(require 'facemenu) ;;; ;;; Variables controlling the display @@ -538,4 +538,6 @@ the range of text to assign text property SYMBOL with value VALUE." (list start end 'display prop) (list start end 'display (list 'disable-eval prop))))) +(provide 'enriched) + ;;; enriched.el ends here commit e25c1b5cd390a7a3f76f9309455d9632a36e373b Author: Eric Abrahamsen Date: Sun Jul 11 09:00:33 2021 -0700 Further tweaks to gnus-search-query-expand-key * lisp/gnus/gnus-search.el (gnus-search-query-expand-key): It's possible that KEY could be partially completed (ie no longer string= to COMP), but not all the way. Use a more accurate test. Add docstring. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 8627619e96..39bde837b3 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -629,12 +629,19 @@ gnus-*-mark marks, and return an appropriate string." mark)) (defun gnus-search-query-expand-key (key) + "Attempt to expand KEY to a full keyword. +Use `gnus-search-expandable-keys' as a completion table; return +KEY directly if it can't be completed. Raise an error if KEY is +ambiguous, meaning that it is a prefix of multiple known +keywords. This means that it's not possible to enter a custom +keyword that happens to be a prefix of a known keyword." (let ((comp (try-completion key gnus-search-expandable-keys))) (if (or (eql comp 't) ; Already a key. (null comp)) ; An unknown key. key - (if (string= comp key) - ;; KEY matches multiple possible keys. + (if (null (member comp gnus-search-expandable-keys)) + ;; KEY is a prefix of multiple known keywords, and could not + ;; be completed to something unique. (signal 'gnus-search-parse-error (list (format "Ambiguous keyword: %s" key))) ;; We completed to a unique known key. commit ad6ad1646d7b3e9fac8198dc734d500ae0d40d78 Author: Michael Albinus Date: Sun Jul 11 17:41:33 2021 +0200 Use `auto-save-file-name-p' in tramp-*-write-region * lisp/net/tramp.el (tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region): Use `auto-save-file-name-p'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 788548bade..63fd5eb06a 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -549,14 +549,13 @@ But handle the case, if the \"test\" command is not available." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let* ((auto-saving - (string-match-p "^#.+#$" (file-name-nondirectory filename))) - file-locked - (curbuf (current-buffer)) - (tmpfile (tramp-compat-make-temp-file filename))) + (let (file-locked + (curbuf (current-buffer)) + (tmpfile (tramp-compat-make-temp-file filename))) ;; Lock file. - (when (and (not auto-saving) (file-remote-p lockname) + (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) + (file-remote-p lockname) (not (eq (file-locked-p lockname) t))) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 404e9aff7a..e5929bd366 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3249,9 +3249,7 @@ implementation will be used." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((auto-saving - (string-match-p "^#.+#$" (file-name-nondirectory filename))) - file-locked + (let (file-locked (uid (or (tramp-compat-file-attribute-user-id (file-attributes filename 'integer)) (tramp-get-remote-uid v 'integer))) @@ -3260,7 +3258,8 @@ implementation will be used." (tramp-get-remote-gid v 'integer)))) ;; Lock file. - (when (and (not auto-saving) (file-remote-p lockname) + (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) + (file-remote-p lockname) (not (eq (file-locked-p lockname) t))) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. @@ -3269,15 +3268,11 @@ implementation will be used." (if (and (tramp-local-host-p v) ;; `file-writable-p' calls `file-expand-file-name'. We ;; cannot use `tramp-run-real-handler' therefore. - (let (file-name-handler-alist) - (and - (file-writable-p (file-name-directory localname)) - (or (file-directory-p localname) - (file-writable-p localname))))) + (file-writable-p (file-name-directory localname)) + (or (file-directory-p localname) + (file-writable-p localname))) ;; Short track: if we are on the local host, we can run directly. - (write-region - start end localname append 'no-message - (and lockname (file-local-name lockname))) + (write-region start end localname append 'no-message lockname) (let* ((modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 87f62391e3..d3de0455dd 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1589,14 +1589,13 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((auto-saving - (string-match-p "^#.+#$" (file-name-nondirectory filename))) - file-locked + (let (file-locked (curbuf (current-buffer)) (tmpfile (tramp-compat-make-temp-file filename))) ;; Lock file. - (when (and (not auto-saving) (file-remote-p lockname) + (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) + (file-remote-p lockname) (not (eq (file-locked-p lockname) t))) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 3a3703b267..f4872cef10 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -295,12 +295,11 @@ arguments to pass to the OPERATION." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((auto-saving - (string-match-p "^#.+#$" (file-name-nondirectory filename))) - file-locked) + (let (file-locked) ;; Lock file. - (when (and (not auto-saving) (file-remote-p lockname) + (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) + (file-remote-p lockname) (not (eq (file-locked-p lockname) t))) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index fc714c9339..9e6bfceb49 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4438,9 +4438,7 @@ of." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((auto-saving - (string-match-p "^#.+#$" (file-name-nondirectory filename))) - file-locked + (let (file-locked (tmpfile (tramp-compat-make-temp-file filename)) (modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) @@ -4452,7 +4450,8 @@ of." (tramp-get-remote-gid v 'integer)))) ;; Lock file. - (when (and (not auto-saving) (file-remote-p lockname) + (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) + (file-remote-p lockname) (not (eq (file-locked-p lockname) t))) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. commit 56c9ecc78a94a6154ecf3434ae8b40ce04d0a9ce Author: Eli Zaretskii Date: Sun Jul 11 18:22:51 2021 +0300 Fix compilation of the --with-wide-int configuration * src/alloc.c (mark_maybe_pointer): Fix a recent change for WIDE_EMACS_INT builds. (Bug#49261) diff --git a/src/alloc.c b/src/alloc.c index b3668d2131..e3b038c51c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4764,7 +4764,11 @@ mark_maybe_pointer (void *p, bool symbol_only) from Emacs source code, it can occur in some cases. To fix this problem, the pdumper code should grok non-initial addresses, as the non-pdumper code does. */ +#ifdef WIDE_EMACS_INT + uintptr_t mask = ~((uintptr_t) 0); +#else uintptr_t mask = VALMASK; +#endif void *po = (void *) ((uintptr_t) p & mask); char *cp = p; char *cpo = po; commit 46f9949e1fc29489b02c31fa4f7620afe580be1b Author: Basil L. Contovounesios Date: Sun Jul 11 11:55:31 2021 +0100 ; Fix misspellings of 'occurrence' in docs. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index b71748c083..feb9e58f31 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4432,7 +4432,7 @@ ThXs Xs the contents of the buffer before. @defun subst-char-in-string fromchar tochar string &optional inplace @cindex replace characters in string -This function replaces all occurences of the character @var{fromchar} +This function replaces all occurrences of the character @var{fromchar} with @var{tochar} in @var{string}. By default, substitution occurs in a copy of @var{string}, but if the optional argument @var{inplace} is non-@code{nil}, the function modifies the @var{string} itself. In any diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 56675eb865..8627619e96 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -448,10 +448,10 @@ auto-completion of contact names and addresses for keys like Date values (any key in `gnus-search-date-keys') can be provided in any format that `parse-time-string' can parse (note that this can produce weird results). Dates with missing bits will be -interpreted as the most recent occurence thereof (ie \"march 03\" -is the most recent March 3rd). Lastly, relative specifications -such as 1d (one day ago) are understood. This also accepts w, m, -and y. m is assumed to be 30 days. +interpreted as the most recent occurrence thereof (i.e. \"march +03\" is the most recent March 3rd). Lastly, relative +specifications such as 1d (one day ago) are understood. This +also accepts w, m, and y. m is assumed to be 30 days. This function will accept pretty much anything as input. Its only job is to parse the query into a sexp, and pass that on -- @@ -644,8 +644,8 @@ gnus-*-mark marks, and return an appropriate string." "Return a string from the current buffer. If DELIMITED is non-nil, assume the next character is a delimiter character, and return everything between point and the next -occurence of the delimiter, including the delimiters themselves. -If TRIM is non-nil, do not return the delimiters. Otherwise, +occurrence of the delimiter, including the delimiters themselves. +If TRIM is non-nil, do not return the delimiters. Otherwise, return one word." ;; This function cannot handle nested delimiters, as it's not a ;; proper parser. Ie, you cannot parse "to:bob or (from:bob or commit 5b9daab3a745577441b0966d0b8e2bb261cdb976 Author: Eli Zaretskii Date: Sun Jul 11 13:15:34 2021 +0300 ; * doc/lispref/text.texi (Substitution): Fix a recent change. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 71a8efe362..b71748c083 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4399,7 +4399,8 @@ based on their character codes. @cindex replace characters This function replaces all occurrences of the character @var{old-char} with the character @var{new-char} in the region of the current buffer -defined by @var{start} and @var{end}. +defined by @var{start} and @var{end}. Both characters must have the +same length of their multibyte form. @cindex undo avoidance If @var{noundo} is non-@code{nil}, then @code{subst-char-in-region} does @@ -4432,10 +4433,10 @@ ThXs Xs the contents of the buffer before. @defun subst-char-in-string fromchar tochar string &optional inplace @cindex replace characters in string This function replaces all occurences of the character @var{fromchar} -with @var{tochar} in @var{string}. Unless @var{inplace} is non-nil, -substitution occurs in a copy of @var{string}. In any case, the -function returns the resulting string. Both characters must have the -same multi-byte length. +with @var{tochar} in @var{string}. By default, substitution occurs in +a copy of @var{string}, but if the optional argument @var{inplace} is +non-@code{nil}, the function modifies the @var{string} itself. In any +case, the function returns the resulting string. @end defun @deffn Command translate-region start end table commit 3b29afa68070f3040f08fec0077213f9a15d1adc Author: Paul Eggert Date: Sun Jul 11 01:12:00 2021 -0700 Pacify GCC 11.1.1 20210531 (Red Hat 11.1.1-3) * src/image.c (xpm_load_image): * src/xfns.c (x_icon): Rework to pacify gcc -Wmaybe-uninitialized. diff --git a/src/image.c b/src/image.c index 07de4d31aa..e2f3220dd2 100644 --- a/src/image.c +++ b/src/image.c @@ -4991,7 +4991,7 @@ xpm_load_image (struct frame *f, while (num_colors-- > 0) { - char *color, *max_color; + char *color, *max_color = NULL; int key, next_key, max_key = 0; Lisp_Object symbol_color = Qnil, color_val; Emacs_Color cdef; @@ -5052,7 +5052,7 @@ xpm_load_image (struct frame *f, cdef.blue)); } } - if (NILP (color_val) && max_key > 0) + if (NILP (color_val) && max_color) { if (xstrcasecmp (max_color, "None") == 0) color_val = Qt; diff --git a/src/xfns.c b/src/xfns.c index e46616e6d6..81349d0b50 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -3361,17 +3361,19 @@ x_icon (struct frame *f, Lisp_Object parms) = gui_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); int icon_xval, icon_yval; - if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) + bool xgiven = !EQ (icon_x, Qunbound); + bool ygiven = !EQ (icon_y, Qunbound); + if (xgiven != ygiven) + error ("Both left and top icon corners of icon must be specified"); + if (xgiven) { icon_xval = check_integer_range (icon_x, INT_MIN, INT_MAX); icon_yval = check_integer_range (icon_y, INT_MIN, INT_MAX); } - else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) - error ("Both left and top icon corners of icon must be specified"); block_input (); - if (! EQ (icon_x, Qunbound)) + if (xgiven) x_wm_set_icon_position (f, icon_xval, icon_yval); #if false /* gui_display_get_arg removes the visibility parameter as a commit f6472cc8e2fdcfd7365240783f34e101fe44142b Author: Paul Eggert Date: Sun Jul 11 00:54:32 2021 -0700 Make pdumper-marking pickier Prevent some false-positives in conservative GC marking. This doesn’t fix any correctness bugs; it’s merely to reclaim some memory instead of keeping it unnecessarily. * src/alloc.c (mark_maybe_pointer): New arg SYMBOL_ONLY. All callers changed. Check that the pointer’s tag, if any, matches the pdumper-reported type. diff --git a/src/alloc.c b/src/alloc.c index 752eaec135..b3668d2131 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4740,7 +4740,7 @@ live_small_vector_p (struct mem_node *m, void *p) marked. */ static void -mark_maybe_pointer (void *p) +mark_maybe_pointer (void *p, bool symbol_only) { struct mem_node *m; @@ -4765,15 +4765,21 @@ mark_maybe_pointer (void *p) this problem, the pdumper code should grok non-initial addresses, as the non-pdumper code does. */ uintptr_t mask = VALMASK; - p = (void *) ((uintptr_t) p & mask); + void *po = (void *) ((uintptr_t) p & mask); + char *cp = p; + char *cpo = po; /* Don't use pdumper_object_p_precise here! It doesn't check the tag bits. OBJ here might be complete garbage, so we need to verify both the pointer and the tag. */ - int type = pdumper_find_object_type (p); - if (pdumper_valid_object_type_p (type)) - mark_object (type == Lisp_Symbol - ? make_lisp_symbol (p) - : make_lisp_ptr (p, type)); + int type = pdumper_find_object_type (po); + if (pdumper_valid_object_type_p (type) + && (!USE_LSB_TAG || p == po || cp - cpo == type)) + { + if (type == Lisp_Symbol) + mark_object (make_lisp_symbol (po)); + else if (!symbol_only) + mark_object (make_lisp_ptr (po, type)); + } return; } @@ -4791,6 +4797,8 @@ mark_maybe_pointer (void *p) case MEM_TYPE_CONS: { + if (symbol_only) + return; struct Lisp_Cons *h = live_cons_holding (m, p); if (!h) return; @@ -4800,6 +4808,8 @@ mark_maybe_pointer (void *p) case MEM_TYPE_STRING: { + if (symbol_only) + return; struct Lisp_String *h = live_string_holding (m, p); if (!h) return; @@ -4818,6 +4828,8 @@ mark_maybe_pointer (void *p) case MEM_TYPE_FLOAT: { + if (symbol_only) + return; struct Lisp_Float *h = live_float_holding (m, p); if (!h) return; @@ -4827,6 +4839,8 @@ mark_maybe_pointer (void *p) case MEM_TYPE_VECTORLIKE: { + if (symbol_only) + return; struct Lisp_Vector *h = live_large_vector_holding (m, p); if (!h) return; @@ -4836,6 +4850,8 @@ mark_maybe_pointer (void *p) case MEM_TYPE_VECTOR_BLOCK: { + if (symbol_only) + return; struct Lisp_Vector *h = live_small_vector_holding (m, p); if (!h) return; @@ -4897,7 +4913,7 @@ mark_memory (void const *start, void const *end) for (pp = start; (void const *) pp < end; pp += GC_POINTER_ALIGNMENT) { void *p = *(void *const *) pp; - mark_maybe_pointer (p); + mark_maybe_pointer (p, false); /* Unmask any struct Lisp_Symbol pointer that make_lisp_symbol previously disguised by adding the address of 'lispsym'. @@ -4906,7 +4922,7 @@ mark_memory (void const *start, void const *end) non-adjacent words and P might be the low-order word's value. */ intptr_t ip; INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip); - mark_maybe_pointer ((void *) ip); + mark_maybe_pointer ((void *) ip, true); } } commit 2f7afef5ffe023a7a12520201ab70643f826abfd Author: Paul Eggert Date: Sun Jul 11 00:27:43 2021 -0700 Fix pdumper-related GC bug * src/alloc.c (mark_maybe_pointer): Also mark pointers to pdumper objects, even when the pointers are tagged. Add a FIXME saying why this isn’t enough. diff --git a/src/alloc.c b/src/alloc.c index 76d8c7ddd1..752eaec135 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4755,6 +4755,17 @@ mark_maybe_pointer (void *p) definitely _don't_ have an object. */ if (pdumper_object_p (p)) { + /* FIXME: This code assumes that every reachable pdumper object + is addressed either by a pointer to the object start, or by + the same pointer with an LSB-style tag. This assumption + fails if a pdumper object is reachable only via machine + addresses of non-initial object components. Although such + addressing is rare in machine code generated by C compilers + from Emacs source code, it can occur in some cases. To fix + this problem, the pdumper code should grok non-initial + addresses, as the non-pdumper code does. */ + uintptr_t mask = VALMASK; + p = (void *) ((uintptr_t) p & mask); /* Don't use pdumper_object_p_precise here! It doesn't check the tag bits. OBJ here might be complete garbage, so we need to verify both the pointer and the tag. */ commit d93ff9459feb77ed5df0d3af563d1280ff42062f Author: Eric Abrahamsen Date: Sat Jul 10 10:00:32 2021 -0700 Rewrite gnus-search-query-expand-key * lisp/gnus/gnus-search.el (gnus-search-query-expand-key): There was a misunderstanding about how completion-all-completion works (if the test string can't be completed, the whole table is returned). Simplify to use try-completion. * test/lisp/gnus/gnus-search-tests.el (gnus-s-expand-keyword): Ensure that an unknown/uncompletable keyword is returned unmolested. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 898b57bcef..56675eb865 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -629,18 +629,16 @@ gnus-*-mark marks, and return an appropriate string." mark)) (defun gnus-search-query-expand-key (key) - (cond ((test-completion key gnus-search-expandable-keys) - ;; We're done! - key) - ;; There is more than one possible completion. - ((consp (cdr (completion-all-completions - key gnus-search-expandable-keys #'stringp 0))) - (signal 'gnus-search-parse-error - (list (format "Ambiguous keyword: %s" key)))) - ;; Return KEY, either completed or untouched. - ((car-safe (completion-try-completion - key gnus-search-expandable-keys - #'stringp 0))))) + (let ((comp (try-completion key gnus-search-expandable-keys))) + (if (or (eql comp 't) ; Already a key. + (null comp)) ; An unknown key. + key + (if (string= comp key) + ;; KEY matches multiple possible keys. + (signal 'gnus-search-parse-error + (list (format "Ambiguous keyword: %s" key))) + ;; We completed to a unique known key. + comp)))) (defun gnus-search-query-return-string (&optional delimited trim) "Return a string from the current buffer. diff --git a/test/lisp/gnus/gnus-search-tests.el b/test/lisp/gnus/gnus-search-tests.el index e30ed9a80a..6148da6562 100644 --- a/test/lisp/gnus/gnus-search-tests.el +++ b/test/lisp/gnus/gnus-search-tests.el @@ -49,7 +49,9 @@ (default-value 'gnus-search-expandable-keys)) (pairs '(("su" . "subject") - ("sin" . "since")))) + ("sin" . "since") + ("body" . "body") + ("list-id" . "list-id")))) (dolist (p pairs) (should (equal (gnus-search-query-expand-key (car p)) (cdr p)))) commit e7f6bb38ddb71bfe08bdca87119ff13cd40ecf62 Author: Eric Abrahamsen Date: Sat Jun 26 10:16:19 2021 -0700 Rework gnus-search-indexed-parse-output * lisp/gnus/gnus-search.el (gnus-search-indexed-parse-output): Be more careful about matching filesystem paths to Gnus group names; make absolutely sure that we only return valid article numbers. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 70bde264c1..898b57bcef 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1351,68 +1351,59 @@ Returns a list of [group article score] vectors." (cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed) server query &optional groups) - (let ((prefix (slot-value engine 'remove-prefix)) - (group-regexp (when groups - (mapconcat - (lambda (group-name) - (mapconcat #'regexp-quote - (split-string - (gnus-group-real-name group-name) - "[.\\/]") - "[.\\\\/]")) - groups - "\\|"))) - artlist vectors article group) + (let ((prefix (or (slot-value engine 'remove-prefix) + "")) + artlist article group) (goto-char (point-min)) + ;; Prep prefix, we want to at least be removing the root + ;; filesystem separator. + (when (stringp prefix) + (setq prefix (file-name-as-directory + (expand-file-name prefix "/")))) (while (not (or (eobp) (looking-at-p "\\(?:[[:space:]\n]+\\)?Process .+ finished"))) (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine))) (when (and f-name (file-readable-p f-name) - (null (file-directory-p f-name)) - (or (null groups) - (and (gnus-search-single-p query) - (alist-get 'thread query)) - (string-match-p group-regexp f-name))) - (push (list f-name score) artlist)))) + (null (file-directory-p f-name))) + (setq group + (replace-regexp-in-string + "[/\\]" "." + (replace-regexp-in-string + "/?\\(cur\\|new\\|tmp\\)?/\\'" "" + (replace-regexp-in-string + "\\`\\." "" + (string-remove-prefix + prefix (file-name-directory f-name)) + nil t) + nil t) + nil t)) + (setq group (gnus-group-full-name group server)) + (setq article (file-name-nondirectory f-name) + article + ;; TODO: Provide a cleaner way of producing final + ;; article numbers for the various backends. + (if (string-match-p "\\`[[:digit:]]+\\'" article) + (string-to-number article) + (nnmaildir-base-name-to-article-number + (substring article 0 (string-match ":" article)) + group (string-remove-prefix "nnmaildir:" server)))) + (when (and (numberp article) + (or (null groups) + (member group groups))) + (push (list f-name article group score) + artlist))))) ;; Are we running an additional grep query? (when-let ((grep-reg (alist-get 'grep query))) (setq artlist (gnus-search-grep-search engine artlist grep-reg))) - ;; Prep prefix. - (when (and prefix (null (string-empty-p prefix))) - (setq prefix (file-name-as-directory (expand-file-name prefix)))) - ;; Turn (file-name score) into [group article score]. - (pcase-dolist (`(,f-name ,score) artlist) - (setq article (file-name-nondirectory f-name) - group (file-name-directory f-name)) - ;; Remove prefix. - (when prefix - (setq group (string-remove-prefix prefix group))) - ;; Break the directory name down until it's something that - ;; (probably) can be used as a group name. - (setq group - (replace-regexp-in-string - "[/\\]" "." - (replace-regexp-in-string - "/?\\(cur\\|new\\|tmp\\)?/\\'" "" - (replace-regexp-in-string - "^[./\\]" "" - group nil t) - nil t) - nil t)) - - (push (vector (gnus-group-full-name group server) - (if (string-match-p "\\`[[:digit:]]+\\'" article) - (string-to-number article) - (nnmaildir-base-name-to-article-number - (substring article 0 (string-match ":" article)) - group (string-remove-prefix "nnmaildir:" server))) - (if (numberp score) - score - (string-to-number score))) - vectors)) - vectors)) + ;; Munge into the list of vectors expected by nnselect. + (mapcar (pcase-lambda (`(,_ ,article ,group ,score)) + (vector group article + (if (numberp score) + score + (string-to-number score)))) + artlist))) (cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed)) "Base implementation treats the whole line as a filename, and commit 0897ade8f90e492b9506ec58fe872722d90b8148 Author: Matthew White Date: Sun Jul 11 00:49:12 2021 +0200 * src/buffer.c (kill-buffer): Fix a typo. * src/buffer.c (Fkill_buffer): Fix typo in comment. diff --git a/src/buffer.c b/src/buffer.c index bbb0edd792..02ca23eb2d 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1757,7 +1757,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) if (thread_check_current_buffer (b)) return Qnil; - /* Run hooks with the buffer to be killed the current buffer. */ + /* Run hooks with the buffer to be killed as the current buffer. */ { ptrdiff_t count = SPECPDL_INDEX (); commit b7a495f8d032e7c60f490a4a822f854707f02275 Author: Filipp Gunbin Date: Sat Jul 10 19:00:01 2021 +0200 doc/lispref/text.texi (Substitution): Add subst-char-in-string * doc/lispref/text.texi (Substitution): Document subst-char-in-string (bug#49420). diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 0c87a19fa1..71a8efe362 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4428,6 +4428,16 @@ ThXs Xs the contents of the buffer before. @end example @end defun + +@defun subst-char-in-string fromchar tochar string &optional inplace +@cindex replace characters in string +This function replaces all occurences of the character @var{fromchar} +with @var{tochar} in @var{string}. Unless @var{inplace} is non-nil, +substitution occurs in a copy of @var{string}. In any case, the +function returns the resulting string. Both characters must have the +same multi-byte length. +@end defun + @deffn Command translate-region start end table This function applies a translation table to the characters in the buffer between positions @var{start} and @var{end}. commit da7dbfdf6858c4644a8d082639edd8a532e47c42 Author: Lars Ingebrigtsen Date: Sat Jul 10 18:53:28 2021 +0200 Make package-menu-filter-by-status work as documented * lisp/emacs-lisp/package.el (package-menu-filter-by-status): Work as documented (bug#49474). diff --git a/etc/NEWS b/etc/NEWS index da5524a555..923cfcc472 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1493,6 +1493,14 @@ This is a slightly deeper copy than the previous 'copy-sequence'. ** Package +--- +*** '/ s' ('package-menu-filter-by-status') changes parameter handling. +The command was documented to take a comma-separated list of statuses +to filter by, but instead it used the parameter as a regexp. The +command has been changed so that it now works as documented, and +checks statuses not as a regexp, but instead an exact match from the +comma-separated list. + +++ *** New command 'package-browse-url' and keystroke 'w'. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index a0f1ab0ed6..6bbd4c9976 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3954,9 +3954,14 @@ packages." (package--ensure-package-menu-mode) (if (or (not status) (string-empty-p status)) (package-menu--generate t t) - (package-menu--filter-by (lambda (pkg-desc) - (string-match-p status (package-desc-status pkg-desc))) - (format "status:%s" status)))) + (let ((status-list + (if (listp status) + status + (split-string status ",")))) + (package-menu--filter-by + (lambda (pkg-desc) + (member (package-desc-status pkg-desc) status-list)) + (format "status:%s" (string-join status-list ",")))))) (defun package-menu-filter-by-version (version predicate) "Filter the \"*Packages*\" buffer by VERSION and PREDICATE. commit 3fa711c11d1497418fdf8a866b7ba52dd3b00e0e Author: Ken Brown Date: Fri Jul 9 16:37:52 2021 -0400 Skip a process test on Cygwin to avoid hang * test/src/process-tests.el (process-tests/fd-setsize-no-crash/make-network-process): Skip test on Cygwin to avoid hang due to connect/accept handshake. (Bug#49496) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index b64c82c87d..1774f2fc74 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -626,6 +626,8 @@ FD_SETSIZE file descriptors (Bug#24325)." FD_SETSIZE file descriptors (Bug#24325)." (skip-unless (featurep 'make-network-process '(:server t))) (skip-unless (featurep 'make-network-process '(:family local))) + ;; Avoid hang due to connect/accept handshake on Cygwin (bug#49496). + (skip-unless (not (eq system-type 'cygwin))) (with-timeout (60 (ert-fail "Test timed out")) (process-tests--with-temp-directory directory (process-tests--with-processes processes commit b423848b5eb83fce894a1c5fa12a498d64e44da2 Author: Stefan Monnier Date: Fri Jul 9 15:53:38 2021 -0400 * lisp/facemenu.el: Preload the C-mouse-2 menu binding diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 9d75302a97..8631be917a 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -244,6 +244,8 @@ return a string which is inserted. It may set `facemenu-end-add-face'." (define-key map [fc] (cons "Face" 'facemenu-face-menu))) (defalias 'facemenu-menu facemenu-menu) +;;;###autoload (autoload 'facemenu-menu "facemenu" nil nil 'keymap) +;;;###autoload (define-key global-map [C-down-mouse-2] 'facemenu-menu) (easy-menu-add-item commit 9ce6541ac9710933beca7f9944087fe4849d5ae9 Author: Michael Albinus Date: Fri Jul 9 18:14:19 2021 +0200 Further cleanup for file locks * doc/misc/tramp.texi (Top, Configuration): Adapt node name for file locks. (Auto-save File Lock and Backup): Rename node name and section title. Add file-lock to @cindex. Describe file locks. * lisp/dired.el (dired-trivial-filenames): Add lock files. (dired-font-lock-keywords): Move files suffixed with `completion-ignored-extensions' up. Add lock files to these checks. * lisp/net/tramp.el (tramp-get-lock-file, tramp-handle-unlock-file): Use `when-let' (tramp-lock-file-info-regexp): Rename from `tramp-lock-file-contents-regexp'. (tramp-handle-file-locked-p, tramp-handle-lock-file): Adapt callees. (tramp-handle-lock-file): Set file modes of lockname. * src/buffer.c (Frestore_buffer_modified_p): * src/fileio.c (write_region): * src/insdel.c (prepare_to_modify_buffer_1): Call Flock_file. * src/filelock.c (Qmake_lock_file_name): Declare symbol. (make_lock_file_name): Use it. Don't check Fboundp, it doesn't work for interned symbols. (lock_file): Return a Lisp_Object. Don't check create_lockfiles. Remove MSDOS version of the function. (Flock_file): Check create_lockfiles. (Flock_buffer): Call Flock_file. * src/lisp.h (lock_file): Remove. * test/lisp/shadowfile-tests.el (shadow-test08-shadow-todo) (shadow-test09-shadow-copy-files): Let-bind `create-lockfiles'. * test/lisp/net/tramp-tests.el (create-lockfiles): Don't set it globally. (tramp-test39-lock-file): Check also for `set-visited-file-name'. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6ef9459077..8ba5f0118a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -142,7 +142,8 @@ Configuring @value{tramp} for use * Remote shell setup:: Remote shell setup hints. * FUSE setup:: @acronym{FUSE} setup hints. * Android shell setup:: Android shell setup hints. -* Auto-save and Backup:: Auto-save and Backup. +* Auto-save File Lock and Backup:: + Auto-save, File Lock and Backup. * Keeping files encrypted:: Protect remote files by encryption. * Windows setup hints:: Issues with Cygwin ssh. @@ -691,7 +692,8 @@ may be used in your init file: * Remote shell setup:: Remote shell setup hints. * FUSE setup:: @acronym{FUSE} setup hints. * Android shell setup:: Android shell setup hints. -* Auto-save and Backup:: Auto-save and Backup. +* Auto-save File Lock and Backup:: + Auto-save, File Lock and Backup. * Keeping files encrypted:: Protect remote files by encryption. * Windows setup hints:: Issues with Cygwin ssh. @end menu @@ -2745,9 +2747,10 @@ Open a remote connection with a more concise command @kbd{C-x C-f @end itemize -@node Auto-save and Backup -@section Auto-save and Backup configuration +@node Auto-save File Lock and Backup +@section Auto-save, File Lock and Backup configuration @cindex auto-save +@cindex file-lock @cindex backup @vindex backup-directory-alist @@ -2842,6 +2845,19 @@ auto-saved files to the same directory as the original file. Alternatively, set the user option @code{tramp-auto-save-directory} to direct all auto saves to that location. +@vindex lock-file-name-transforms +And still more issues to handle. Since @w{Emacs 28}, file locks use a +similar user option as auto-save files, called +@code{lock-file-name-transforms}. By default this user option is +@code{nil}, meaning to keep file locks in the same directory as the +original file. + +If you change @code{lock-file-name-transforms} in order to keep file +locks for remote files somewhere else, you will loose Emacs' feature +to warn you, if a file is changed in parallel from different Emacs +sessions, or via different remote connections. Be careful with such +settings. + @vindex tramp-allow-unsafe-temporary-files Per default, @value{tramp} asks for confirmation if a @samp{root}-owned backup or auto-save remote file has to be written to diff --git a/lisp/dired.el b/lisp/dired.el index 9ddd2c542d..fb353a92e4 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -163,7 +163,7 @@ always set this variable to t." :type 'boolean :group 'dired-mark) -(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#") +(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`\\.?#") "Regexp of files to skip when finding first file of a directory. A value of nil means move to the subdir line. A value of t means move to first file." @@ -615,6 +615,31 @@ Subexpression 2 must end right before the \\n.") (list dired-re-dir '(".+" (dired-move-to-filename) nil (0 dired-directory-face))) ;; + ;; Files suffixed with `completion-ignored-extensions'. + '(eval . + ;; It is quicker to first find just an extension, then go back to the + ;; start of that file name. So we do this complex MATCH-ANCHORED form. + (list (concat + "\\(" (regexp-opt completion-ignored-extensions) + "\\|#\\|\\.#.+\\)$") + '(".+" (dired-move-to-filename) nil (0 dired-ignored-face)))) + ;; + ;; Files suffixed with `completion-ignored-extensions' + ;; plus a character put in by -F. + '(eval . + (list (concat "\\(" (regexp-opt completion-ignored-extensions) + "\\|#\\|\\.#.+\\)[*=|]$") + '(".+" (progn + (end-of-line) + ;; If the last character is not part of the filename, + ;; move back to the start of the filename + ;; so it can be fontified. + ;; Otherwise, leave point at the end of the line; + ;; that way, nothing is fontified. + (unless (get-text-property (1- (point)) 'mouse-face) + (dired-move-to-filename))) + nil (0 dired-ignored-face)))) + ;; ;; Broken Symbolic link. (list dired-re-sym (list (lambda (end) @@ -659,29 +684,6 @@ Subexpression 2 must end right before the \\n.") (list dired-re-special '(".+" (dired-move-to-filename) nil (0 'dired-special))) ;; - ;; Files suffixed with `completion-ignored-extensions'. - '(eval . - ;; It is quicker to first find just an extension, then go back to the - ;; start of that file name. So we do this complex MATCH-ANCHORED form. - (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$") - '(".+" (dired-move-to-filename) nil (0 dired-ignored-face)))) - ;; - ;; Files suffixed with `completion-ignored-extensions' - ;; plus a character put in by -F. - '(eval . - (list (concat "\\(" (regexp-opt completion-ignored-extensions) - "\\|#\\)[*=|]$") - '(".+" (progn - (end-of-line) - ;; If the last character is not part of the filename, - ;; move back to the start of the filename - ;; so it can be fontified. - ;; Otherwise, leave point at the end of the line; - ;; that way, nothing is fontified. - (unless (get-text-property (1- (point)) 'mouse-face) - (dired-move-to-filename))) - nil (0 dired-ignored-face)))) - ;; ;; Explicitly put the default face on file names ending in a colon to ;; avoid fontifying them as directory header. (list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7578d6fe30..fc714c9339 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3819,9 +3819,9 @@ User is always nil." (cons (expand-file-name filename) (cdr result))))) (defun tramp-get-lock-file (file) - "Read lockfile of FILE. -Return nil when there is no lockfile" - (let ((lockname (tramp-compat-make-lock-file-name file))) + "Read lockfile info of FILE. +Return nil when there is no lockfile." + (when-let ((lockname (tramp-compat-make-lock-file-name file))) (or (file-symlink-p lockname) (and (file-readable-p lockname) (with-temp-buffer @@ -3839,51 +3839,53 @@ Return nil when there is no lockfile" (or (process-id p) (tramp-get-connection-property p "lock-pid" (emacs-pid)))))) -(defconst tramp-lock-file-contents-regexp +(defconst tramp-lock-file-info-regexp ;; USER@HOST.PID[:BOOT_TIME] "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'" "The format of a lock file.") (defun tramp-handle-file-locked-p (file) "Like `file-locked-p' for Tramp files." - (when-let ((contents (tramp-get-lock-file file)) - (match (string-match tramp-lock-file-contents-regexp contents))) - (or (and (string-equal (match-string 1 contents) (user-login-name)) - (string-equal (match-string 2 contents) (system-name)) - (string-equal (match-string 3 contents) (tramp-get-lock-pid file))) - (match-string 1 contents)))) + (when-let ((info (tramp-get-lock-file file)) + (match (string-match tramp-lock-file-info-regexp info))) + (or (and (string-equal (match-string 1 info) (user-login-name)) + (string-equal (match-string 2 info) (system-name)) + (string-equal (match-string 3 info) (tramp-get-lock-pid file))) + (match-string 1 info)))) (defun tramp-handle-lock-file (file) "Like `lock-file' for Tramp files." ;; See if this file is visited and has changed on disk since it ;; was visited. (catch 'dont-lock - (unless (or (null create-lockfiles) - (eq (file-locked-p file) t)) ;; Locked by me. - (when-let ((contents (tramp-get-lock-file file)) - (match (string-match tramp-lock-file-contents-regexp contents))) + (unless (eq (file-locked-p file) t) ;; Locked by me. + (when-let ((info (tramp-get-lock-file file)) + (match (string-match tramp-lock-file-info-regexp info))) (unless (ask-user-about-lock file (format - "%s@%s (pid %s)" (match-string 1 contents) - (match-string 2 contents) (match-string 3 contents))) + "%s@%s (pid %s)" (match-string 1 info) + (match-string 2 info) (match-string 3 info))) (throw 'dont-lock nil))) - (let ((lockname (tramp-compat-make-lock-file-name file)) - ;; USER@HOST.PID[:BOOT_TIME] - (contents - (format - "%s@%s.%s" (user-login-name) (system-name) - (tramp-get-lock-pid file))) - create-lockfiles signal-hook-function) - (condition-case nil - (make-symbolic-link contents lockname 'ok-if-already-exists) - (error (write-region contents nil lockname))))))) + (when-let ((lockname (tramp-compat-make-lock-file-name file)) + ;; USER@HOST.PID[:BOOT_TIME] + (info + (format + "%s@%s.%s" (user-login-name) (system-name) + (tramp-get-lock-pid file)))) + (let (create-lockfiles signal-hook-function) + (condition-case nil + (make-symbolic-link info lockname 'ok-if-already-exists) + (error + (write-region info nil lockname) + (set-file-modes lockname #o0644)))))))) (defun tramp-handle-unlock-file (file) "Like `unlock-file' for Tramp files." - (condition-case err - (delete-file (tramp-compat-make-lock-file-name file)) - (error (userlock--handle-unlock-error err)))) + (when-let ((lockname (tramp-compat-make-lock-file-name file))) + (condition-case err + (delete-file lockname) + (error (userlock--handle-unlock-error err))))) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." diff --git a/src/buffer.c b/src/buffer.c index 3cd47fede3..bbb0edd792 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1449,7 +1449,7 @@ state of the current buffer. Use with care. */) { bool already = SAVE_MODIFF < MODIFF; if (!already && !NILP (flag)) - lock_file (fn); + Flock_file (fn); else if (already && NILP (flag)) Funlock_file (fn); } diff --git a/src/fileio.c b/src/fileio.c index 30e6caf7ea..04c9d7d4af 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5168,7 +5168,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, if (open_and_close_file && !auto_saving) { - lock_file (lockname); + Flock_file (lockname); file_locked = 1; } diff --git a/src/filelock.c b/src/filelock.c index 9f1968f07d..106633f584 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -622,10 +622,7 @@ lock_if_free (lock_info_type *clasher, char *lfname) static Lisp_Object make_lock_file_name (Lisp_Object fn) { - Lisp_Object func = intern ("make-lock-file-name"); - if (NILP (Fboundp (func))) - return Qnil; - return call1 (func, Fexpand_file_name (fn, Qnil)); + return call1 (Qmake_lock_file_name, Fexpand_file_name (fn, Qnil)); } /* lock_file locks file FN, @@ -646,7 +643,7 @@ make_lock_file_name (Lisp_Object fn) This function can signal an error, or return t meaning take away the lock, or return nil meaning ignore the lock. */ -void +static Lisp_Object lock_file (Lisp_Object fn) { lock_info_type lock_info; @@ -655,7 +652,7 @@ lock_file (Lisp_Object fn) Uncompressing wtmp files uses call-process, which does not work in an uninitialized Emacs. */ if (will_dump_p ()) - return; + return Qnil; /* If the file name has special constructs in it, call the corresponding file name handler. */ @@ -663,13 +660,12 @@ lock_file (Lisp_Object fn) handler = Ffind_file_name_handler (fn, Qlock_file); if (!NILP (handler)) { - call2 (handler, Qlock_file, fn); - return; + return call2 (handler, Qlock_file, fn); } Lisp_Object lock_filename = make_lock_file_name (fn); if (NILP (lock_filename)) - return; + return Qnil; char *lfname = SSDATA (ENCODE_FILE (lock_filename)); /* See if this file is visited and has changed on disk since it was @@ -678,32 +674,29 @@ lock_file (Lisp_Object fn) if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (lock_filename)) - && !(create_lockfiles && current_lock_owner (NULL, lfname) == -2)) + && current_lock_owner (NULL, lfname) != -2) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); - /* Don't do locking if the user has opted out. */ - if (create_lockfiles) + /* Try to lock the lock. FIXME: This ignores errors when + lock_if_free returns a positive errno value. */ + if (lock_if_free (&lock_info, lfname) < 0) { - /* Try to lock the lock. FIXME: This ignores errors when - lock_if_free returns a positive errno value. */ - if (lock_if_free (&lock_info, lfname) < 0) - { - /* Someone else has the lock. Consider breaking it. */ - Lisp_Object attack; - char *dot = lock_info.dot; - ptrdiff_t pidlen = lock_info.colon - (dot + 1); - static char const replacement[] = " (pid "; - int replacementlen = sizeof replacement - 1; - memmove (dot + replacementlen, dot + 1, pidlen); - strcpy (dot + replacementlen + pidlen, ")"); - memcpy (dot, replacement, replacementlen); - attack = call2 (intern ("ask-user-about-lock"), fn, - build_string (lock_info.user)); - /* Take the lock if the user said so. */ - if (!NILP (attack)) - lock_file_1 (lfname, 1); - } + /* Someone else has the lock. Consider breaking it. */ + Lisp_Object attack; + char *dot = lock_info.dot; + ptrdiff_t pidlen = lock_info.colon - (dot + 1); + static char const replacement[] = " (pid "; + int replacementlen = sizeof replacement - 1; + memmove (dot + replacementlen, dot + 1, pidlen); + strcpy (dot + replacementlen + pidlen, ")"); + memcpy (dot, replacement, replacementlen); + attack = call2 (intern ("ask-user-about-lock"), fn, + build_string (lock_info.user)); + /* Take the lock if the user said so. */ + if (!NILP (attack)) + lock_file_1 (lfname, 1); } + return Qnil; } static Lisp_Object @@ -732,12 +725,6 @@ unlock_file_handle_error (Lisp_Object err) return Qnil; } -#else /* MSDOS */ -void -lock_file (Lisp_Object fn) -{ -} - #endif /* MSDOS */ void @@ -760,8 +747,14 @@ DEFUN ("lock-file", Flock_file, Slock_file, 1, 1, 0, If the option `create-lockfiles' is nil, this does nothing. */) (Lisp_Object file) { - CHECK_STRING (file); - lock_file (file); +#ifndef MSDOS + /* Don't do locking if the user has opted out. */ + if (create_lockfiles) + { + CHECK_STRING (file); + lock_file (file); + } +#endif /* MSDOS */ return Qnil; } @@ -805,7 +798,7 @@ If the option `create-lockfiles' is nil, this does nothing. */) CHECK_STRING (file); if (SAVE_MODIFF < MODIFF && !NILP (file)) - lock_file (file); + Flock_file (file); return Qnil; } @@ -892,6 +885,7 @@ Info node `(emacs)Interlocking'. */); DEFSYM (Qlock_file, "lock-file"); DEFSYM (Qunlock_file, "unlock-file"); DEFSYM (Qfile_locked_p, "file-locked-p"); + DEFSYM (Qmake_lock_file_name, "make-lock-file-name"); defsubr (&Slock_file); defsubr (&Sunlock_file); diff --git a/src/insdel.c b/src/insdel.c index e38b091f54..e66120eb08 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1989,7 +1989,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end, /* Make binding buffer-file-name to nil effective. */ && !NILP (BVAR (base_buffer, filename)) && SAVE_MODIFF >= MODIFF) - lock_file (BVAR (base_buffer, file_truename)); + Flock_file (BVAR (base_buffer, file_truename)); /* If `select-active-regions' is non-nil, save the region text. */ /* FIXME: Move this to Elisp (via before-change-functions). */ diff --git a/src/lisp.h b/src/lisp.h index ce4b80a27e..1795b9d811 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4621,7 +4621,6 @@ extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern void syms_of_sysdep (void); /* Defined in filelock.c. */ -extern void lock_file (Lisp_Object); extern void unlock_all_files (void); extern void unlock_buffer (struct buffer *); extern void syms_of_filelock (void); diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0e70f8e1d2..44fd1b45b2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -122,7 +122,6 @@ (setq auth-source-save-behavior nil password-cache-expiry nil remote-file-name-inhibit-cache nil - create-lockfiles nil tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil tramp-persistency-file-name nil @@ -5794,16 +5793,16 @@ Use direct async.") ;; Quit the file lock machinery. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) - (should-error (lock-file tmp-name) :type 'file-locked)) - (should (stringp (file-locked-p tmp-name))) - - ;; The same for `write-region'. - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) + (should-error (lock-file tmp-name) :type 'file-locked) + ;; The same for `write-region'. (should-error (write-region "foo" nil tmp-name) :type 'file-locked) (should-error (write-region "foo" nil tmp-name nil nil tmp-name) - :type 'file-locked)) + :type 'file-locked) + ;; The same for `set-visited-file-name'. + (with-temp-buffer + (should-error + (set-visited-file-name tmp-name) :type 'file-locked))) (should (stringp (file-locked-p tmp-name))) (should-not (file-exists-p tmp-name))) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 84a9479480..268bb64f24 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -732,6 +732,7 @@ guaranteed by the originator of a cluster definition." (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) + create-lockfiles (shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) (shadow-inhibit-message t) @@ -877,6 +878,7 @@ guaranteed by the originator of a cluster definition." (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) + create-lockfiles (shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) (shadow-inhibit-message t) commit 92616d30e0a4b5b052d4115c91079f1a14b6d965 Author: Basil L. Contovounesios Date: Fri Jul 9 14:37:50 2021 +0100 ; Fix let-alist Texinfo markup * doc/lispref/lists.texi (Association Lists): Use @result (bug#34842). diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index c54496f616..4697256e07 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1803,7 +1803,7 @@ through a simple example: (let-alist colors (if (eq .rose 'red) .lily)) -=> white + @result{} white @end lisp The @var{body} is inspected at compilation time, and only the symbols @@ -1819,7 +1819,7 @@ Nested association lists is supported: (let-alist colors (if (eq .rose 'red) .lily.belladonna)) -=> yellow + @result{} yellow @end lisp Nesting @code{let-alist} inside each other is allowed, but the code in commit 2870a72d0d6675e189457394ac421bd8e5ab4561 Author: Eli Zaretskii Date: Fri Jul 9 14:37:49 2021 +0300 Partially restore the lost C-mouse-2 drop-down menu This allows to pop up the Text Properties menu once facemenu is loaded. It still doesn't allow C-mouse-2 clicks without manually loading facemenu; FIXME. * lisp/facemenu.el (global-map) : Add back the removed binding. (Bug#49466) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 855ce0be69..9d75302a97 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -244,6 +244,8 @@ return a string which is inserted. It may set `facemenu-end-add-face'." (define-key map [fc] (cons "Face" 'facemenu-face-menu))) (defalias 'facemenu-menu facemenu-menu) +(define-key global-map [C-down-mouse-2] 'facemenu-menu) + (easy-menu-add-item menu-bar-edit-menu nil ["Text Properties" facemenu-menu]) commit c73bc89e663290649e4c9a89b15f96b885bcd736 Author: Stefan Monnier Date: Thu Jul 8 23:00:03 2021 -0400 * lisp/outline.el (outline-mode-cycle-map): Don't bind `tab`. Since it would take precedence over bindings for TAB in higher precedence maps. diff --git a/lisp/outline.el b/lisp/outline.el index 68b8f4b6dd..0bb74ffd64 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -182,7 +182,6 @@ in the file it applies to.") ;; Only takes effect if point is on a heading. :filter ,(lambda (cmd) (when (outline-on-heading-p) cmd))))) - (define-key map [tab] tab-binding) (define-key map (kbd "TAB") tab-binding) (define-key map (kbd "") #'outline-cycle-buffer)) map) commit 4bfdf8c78ee8d4f85f0d226006c3cc891bee837f Author: Michael Albinus Date: Thu Jul 8 21:14:28 2021 +0200 * doc/lispref/files.texi (Magic File Names): Add make-lock-file-name. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index fe3affeef3..b1b70a9f06 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3310,6 +3310,7 @@ first, before handlers for jobs such as remote file access. @code{make-auto-save-file-name}, @code{make-directory}, @code{make-directory-internal}, +@code{make-lock-file-name}, @code{make-nearby-temp-file}, @code{make-process}, @code{make-symbolic-link},@* @@ -3369,6 +3370,8 @@ first, before handlers for jobs such as remote file access. @code{make-auto-save-file-name}, @code{make-direc@discretionary{}{}{}tory}, @code{make-direc@discretionary{}{}{}tory-internal}, +@code{make-lock-file-name}, +@code{make-nearby-temp-file}, @code{make-process}, @code{make-symbolic-link}, @code{process-file}, @@ -3377,6 +3380,7 @@ first, before handlers for jobs such as remote file access. @code{set-visited-file-modtime}, @code{shell-command}, @code{start-file-process}, @code{substitute-in-file-name}, +@code{temporary-file-directory}, @code{unhandled-file-name-directory}, @code{unlock-file}, @code{vc-regis@discretionary{}{}{}tered}, commit a6a92e3ac55b4a07f3b91dffecc28a89c2b5dbf2 Author: Michael Albinus Date: Thu Jul 8 21:13:40 2021 +0200 Code cleanup wrt file locks * lisp/files.el (make-lock-file-name): Fix docstring. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Add `make-lock-file-name'. * lisp/net/tramp.el (tramp-file-name-for-operation): Add `make-lock-file-name'. (tramp-handle-unlock-file): Call `userlock--handle-unlock-error' in case of error. * src/buffer.c (Frestore_buffer_modified_p): * src/editfns.c (Freplace_buffer_contents): * src/fileio.c (Finsert_file_contents, write_region): Call Funlock_file. * src/filelock.c (unlock_file): Rename from unlock_file_body. Remove the other declarations of unlock_file. Move file name handler check to ... (Funlock_file): ... here. Adapt argument numbers. Call unlock_file wrapped by internal_condition_case. (Flock_file): Adapt argument numbers. (unlock_all_files, Funlock_buffer, unlock_buffer): Call Funlock_file. * src/lisp.h (unlock_file): Remove. diff --git a/lisp/files.el b/lisp/files.el index da8598f150..0dfcab8f89 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6795,7 +6795,7 @@ the resulting file name, and SUFFIX is appended." (defun make-lock-file-name (filename) "Make a lock file name for FILENAME. -By default, this just prepends \".*\" to the non-directory part +By default, this just prepends \".#\" to the non-directory part of FILENAME, but the transforms in `lock-file-name-transforms' are done first." (let ((handler (find-file-name-handler filename 'make-lock-file-name))) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 2bd1367145..788548bade 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -164,6 +164,7 @@ It is used for TCP/IP devices." (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-adb-handle-make-directory) (make-directory-internal . ignore) + ;; `make-lock-file-name' performed by default handler. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-adb-handle-make-process) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index a6f479bcbc..67798e892a 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -267,6 +267,7 @@ It must be supported by libarchive(3).") (make-auto-save-file-name . ignore) (make-directory . tramp-archive-handle-not-implemented) (make-directory-internal . tramp-archive-handle-not-implemented) + (make-lock-file-name . ignore) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-archive-handle-not-implemented) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 31988bc9ef..1b77fea7e1 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -213,6 +213,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-crypt-handle-make-directory) (make-directory-internal . ignore) + ;; `make-lock-file-name' performed by default handler. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e784ea83ef..04de5defb3 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -805,6 +805,7 @@ It has been changed in GVFS 1.14.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-gvfs-handle-make-directory) (make-directory-internal . ignore) + ;; `make-lock-file-name' performed by default handler. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 6c710dd0b1..473fa8a8f0 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -127,6 +127,7 @@ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-fuse-handle-make-directory) (make-directory-internal . ignore) + ;; `make-lock-file-name' performed by default handler. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c65800bb0e..404e9aff7a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -993,6 +993,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sh-handle-make-directory) ;; `make-directory-internal' performed by default handler. + ;; `make-lock-file-name' performed by default handler. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-sh-handle-make-process) (make-symbolic-link . tramp-sh-handle-make-symbolic-link) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 01192db920..87f62391e3 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -278,6 +278,7 @@ See `tramp-actions-before-shell' for more info.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-smb-handle-make-directory) (make-directory-internal . tramp-smb-handle-make-directory-internal) + ;; `make-lock-file-name' performed by default handler. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-smb-handle-make-symbolic-link) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index babd770be9..3a3703b267 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -127,6 +127,7 @@ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-fuse-handle-make-directory) (make-directory-internal . ignore) + ;; `make-lock-file-name' performed by default handler. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-handle-make-process) (make-symbolic-link . tramp-handle-make-symbolic-link) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index aa6f85ec6e..d68a5c1adf 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -120,6 +120,7 @@ See `tramp-actions-before-shell' for more info.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sudoedit-handle-make-directory) (make-directory-internal . ignore) + ;; `make-lock-file-name' performed by default handler. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e9e08265fe..7578d6fe30 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2456,7 +2456,7 @@ Must be handled by the callers." ;; Emacs 27+ only. file-system-info ;; Emacs 28+ only. - file-locked-p lock-file unlock-file + file-locked-p lock-file make-lock-file-name unlock-file ;; Tramp internal magic file name function. tramp-set-file-uid-gid)) (if (file-name-absolute-p (nth 0 args)) @@ -3881,8 +3881,9 @@ Return nil when there is no lockfile" (defun tramp-handle-unlock-file (file) "Like `unlock-file' for Tramp files." - (ignore-errors - (delete-file (tramp-compat-make-lock-file-name file)))) + (condition-case err + (delete-file (tramp-compat-make-lock-file-name file)) + (error (userlock--handle-unlock-error err)))) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." diff --git a/lisp/userlock.el b/lisp/userlock.el index 4a75815318..38aaf6aec2 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -230,7 +230,7 @@ to get the latest version of the file, then make the change again." (display-warning '(unlock-file) ;; There is no need to explain that this is an unlock error because - ;; ERR is a `file-error' condition, which explains this. + ;; ERROR is a `file-error' condition, which explains this. (message "%s, ignored" (error-message-string error)) :warning)) diff --git a/src/buffer.c b/src/buffer.c index 565577e75a..3cd47fede3 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1451,7 +1451,7 @@ state of the current buffer. Use with care. */) if (!already && !NILP (flag)) lock_file (fn); else if (already && NILP (flag)) - unlock_file (fn); + Funlock_file (fn); } } diff --git a/src/editfns.c b/src/editfns.c index aa0f46fea0..8ab17ebc9f 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2137,7 +2137,7 @@ nil. */) the file now. */ if (SAVE_MODIFF == MODIFF && STRINGP (BVAR (a, file_truename))) - unlock_file (BVAR (a, file_truename)); + Funlock_file (BVAR (a, file_truename)); } return Qt; diff --git a/src/fileio.c b/src/fileio.c index c0d1a5084a..30e6caf7ea 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -4544,7 +4544,7 @@ by calling `format-decode', which see. */) if (inserted == 0) { if (we_locked_file) - unlock_file (BVAR (current_buffer, file_truename)); + Funlock_file (BVAR (current_buffer, file_truename)); Vdeactivate_mark = old_Vdeactivate_mark; } else @@ -4706,8 +4706,8 @@ by calling `format-decode', which see. */) if (NILP (handler)) { if (!NILP (BVAR (current_buffer, file_truename))) - unlock_file (BVAR (current_buffer, file_truename)); - unlock_file (filename); + Funlock_file (BVAR (current_buffer, file_truename)); + Funlock_file (filename); } if (not_regular) xsignal2 (Qfile_error, @@ -5193,7 +5193,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, { int open_errno = errno; if (file_locked) - unlock_file (lockname); + Funlock_file (lockname); report_file_errno ("Opening output file", filename, open_errno); } @@ -5208,7 +5208,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, { int lseek_errno = errno; if (file_locked) - unlock_file (lockname); + Funlock_file (lockname); report_file_errno ("Lseek error", filename, lseek_errno); } } @@ -5345,7 +5345,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, unbind_to (count, Qnil); if (file_locked) - unlock_file (lockname); + Funlock_file (lockname); /* Do this before reporting IO error to avoid a "file has changed on disk" warning on @@ -5370,14 +5370,14 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, bset_filename (current_buffer, visit_file); update_mode_lines = 14; if (auto_saving_into_visited_file) - unlock_file (lockname); + Funlock_file (lockname); } else if (quietly) { if (auto_saving_into_visited_file) { SAVE_MODIFF = MODIFF; - unlock_file (lockname); + Funlock_file (lockname); } return Qnil; diff --git a/src/filelock.c b/src/filelock.c index 20916ace50..9f1968f07d 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -657,6 +657,8 @@ lock_file (Lisp_Object fn) if (will_dump_p ()) return; + /* If the file name has special constructs in it, + call the corresponding file name handler. */ Lisp_Object handler; handler = Ffind_file_name_handler (fn, Qlock_file); if (!NILP (handler)) @@ -705,20 +707,10 @@ lock_file (Lisp_Object fn) } static Lisp_Object -unlock_file_body (Lisp_Object fn) +unlock_file (Lisp_Object fn) { char *lfname; - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - Lisp_Object handler; - handler = Ffind_file_name_handler (fn, Qunlock_file); - if (!NILP (handler)) - { - call2 (handler, Qunlock_file, fn); - return Qnil; - } - Lisp_Object lock_filename = make_lock_file_name (fn); if (NILP (lock_filename)) return Qnil; @@ -740,26 +732,12 @@ unlock_file_handle_error (Lisp_Object err) return Qnil; } -void -unlock_file (Lisp_Object fn) -{ - internal_condition_case_1 (unlock_file_body, - fn, - list1(Qfile_error), - unlock_file_handle_error); -} - #else /* MSDOS */ void lock_file (Lisp_Object fn) { } -void -unlock_file (Lisp_Object fn) -{ -} - #endif /* MSDOS */ void @@ -773,12 +751,11 @@ unlock_all_files (void) b = XBUFFER (buf); if (STRINGP (BVAR (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) - unlock_file (BVAR (b, file_truename)); + Funlock_file (BVAR (b, file_truename)); } } -DEFUN ("lock-file", Flock_file, Slock_file, - 0, 1, 0, +DEFUN ("lock-file", Flock_file, Slock_file, 1, 1, 0, doc: /* Lock FILE. If the option `create-lockfiles' is nil, this does nothing. */) (Lisp_Object file) @@ -788,13 +765,28 @@ If the option `create-lockfiles' is nil, this does nothing. */) return Qnil; } -DEFUN ("unlock-file", Funlock_file, Sunlock_file, - 0, 1, 0, +DEFUN ("unlock-file", Funlock_file, Sunlock_file, 1, 1, 0, doc: /* Unlock FILE. */) (Lisp_Object file) { +#ifndef MSDOS CHECK_STRING (file); - unlock_file (file); + + /* If the file name has special constructs in it, + call the corresponding file name handler. */ + Lisp_Object handler; + handler = Ffind_file_name_handler (file, Qunlock_file); + if (!NILP (handler)) + { + call2 (handler, Qunlock_file, file); + return Qnil; + } + + internal_condition_case_1 (unlock_file, + file, + list1 (Qfile_error), + unlock_file_handle_error); +#endif /* MSDOS */ return Qnil; } @@ -829,7 +821,7 @@ error did not occur. */) { if (SAVE_MODIFF < MODIFF && STRINGP (BVAR (current_buffer, file_truename))) - unlock_file (BVAR (current_buffer, file_truename)); + Funlock_file (BVAR (current_buffer, file_truename)); return Qnil; } @@ -840,7 +832,7 @@ unlock_buffer (struct buffer *buffer) { if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) && STRINGP (BVAR (buffer, file_truename))) - unlock_file (BVAR (buffer, file_truename)); + Funlock_file (BVAR (buffer, file_truename)); } DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0, diff --git a/src/lisp.h b/src/lisp.h index 4fb8923678..ce4b80a27e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4622,7 +4622,6 @@ extern void syms_of_sysdep (void); /* Defined in filelock.c. */ extern void lock_file (Lisp_Object); -extern void unlock_file (Lisp_Object); extern void unlock_all_files (void); extern void unlock_buffer (struct buffer *); extern void syms_of_filelock (void); commit 274e71f5cc33834a08e7bd24418553198cb01f34 Author: Juri Linkov Date: Thu Jul 8 20:51:15 2021 +0300 Don't turn mouse-1 into mouse-2 when clicking on the tab-line (bug#49247) * lisp/tab-line.el (tab-line-tab-name-format-default): For 'tab-line-tab-map' add the property 'follow-link' with the value 'ignore'. diff --git a/lisp/mouse.el b/lisp/mouse.el index ab260d4ed4..89e5d7c48a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1208,7 +1208,7 @@ overlay property, the value of that property determines what to do. for the `follow-link' event, the binding of that event determines what to do. -The resulting value determine whether POS is inside a link: +The resulting value determines whether POS is inside a link: - If the value is `mouse-face', POS is inside a link if there is a non-nil `mouse-face' property at POS. Return t in this case. @@ -2881,8 +2881,8 @@ is copied instead of being cut." (set-marker (nth 2 state) nil)) (with-current-buffer (window-buffer window) (setq cursor-type (nth 3 state))))))) - + ;;; Bindings for mouse commands. (global-set-key [down-mouse-1] 'mouse-drag-region) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 0d97da8ca7..d5fad35363 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -471,7 +471,10 @@ should return the formatted tab name to display in the tab line." (dolist (fn tab-line-tab-face-functions) (setf face (funcall fn tab tabs face buffer-p selected-p))) (apply 'propertize - (concat (propertize name 'keymap tab-line-tab-map) + (concat (propertize name + 'keymap tab-line-tab-map + ;; Don't turn mouse-1 into mouse-2 (bug#49247) + 'follow-link 'ignore) (or (and (or buffer-p (assq 'buffer tab) (assq 'close tab)) tab-line-close-button-show (not (eq tab-line-close-button-show commit 57354bc64bdec4cfc70908c80325f665ad7fbc20 Author: pillule Date: Thu Jul 8 20:39:39 2021 +0300 Use display-buffer with re-builder (bug#49069) * lisp/emacs-lisp/re-builder.el (re-builder): Uses 'display-buffer' with 'display-buffer-in-direction' to display the reb-buffer. This allow user-customizations and using it on not splitables windows. Add a dedication to its window so killing this buffer quit the window. diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 7d042a9102..396949d59a 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -355,11 +355,16 @@ provided in the Commentary section of this library." (reb-delete-overlays)) (setq reb-target-buffer (current-buffer) reb-target-window (selected-window)) - (select-window (or (get-buffer-window reb-buffer) - (progn - (setq reb-window-config (current-window-configuration)) - (split-window (selected-window) (- (window-height) 4))))) - (switch-to-buffer (get-buffer-create reb-buffer)) + (select-window + (or (get-buffer-window reb-buffer) + (let ((dir (if (window-parameter nil 'window-side) + 'bottom 'down))) + (setq reb-window-config (current-window-configuration)) + (display-buffer + (get-buffer-create reb-buffer) + `((display-buffer-in-direction) + (direction . ,dir) + (dedicated . t)))))) (font-lock-mode 1) (reb-initialize-buffer))) commit 8ab0c04c2c77260e2342515151ed75a87907c007 Author: Lars Ingebrigtsen Date: Thu Jul 8 16:33:28 2021 +0200 Make desktop-kill more robust * lisp/desktop.el (desktop-kill): Allow exiting Emacs even if we can't delete the desktop file (bug#20762). diff --git a/lisp/desktop.el b/lisp/desktop.el index ae8d026acc..b9467c8752 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -759,7 +759,10 @@ is nil, ask the user where to save the desktop." (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") (signal (car err) (cdr err)))))) ;; If we own it, we don't anymore. - (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)) + (when (eq (emacs-pid) (desktop-owner)) + ;; Allow exiting Emacs even if we can't delete the desktop file. + (ignore-error 'file-error + (desktop-release-lock))) t) ;; ---------------------------------------------------------------------------- commit cd1313b7f128e19b3a6554b4e410a71da370a66f Author: Lars Ingebrigtsen Date: Thu Jul 8 16:23:29 2021 +0200 Allow inhibiting inserting #! in sh-set-shell * lisp/progmodes/sh-script.el (sh-set-shell): Allow inhibiting inserting the #! line (bug#20959). diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index c3a12c5b2c..91db4ae21c 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2192,6 +2192,8 @@ Point should be before the newline." When used interactively, insert the proper starting #!-line, and make the visited file executable via `executable-set-magic', perhaps querying depending on the value of `executable-query'. +(If given a prefix (i.e., `C-u') don't insert any starting #! +line.) When this function is called noninteractively, INSERT-FLAG (the third argument) controls whether to insert a #!-line and think about making @@ -2215,7 +2217,7 @@ whose value is the shell name (don't quote it)." '("csh" "rc" "sh")) nil nil nil nil sh-shell-file) (eq executable-query 'function) - t)) + (not current-prefix-arg))) (if (string-match "\\.exe\\'" shell) (setq shell (substring shell 0 (match-beginning 0)))) (setq sh-shell (sh-canonicalize-shell shell)) commit 57eb0db9dc270278db9d51214fae780f020fef6a Author: Lars Ingebrigtsen Date: Thu Jul 8 15:46:38 2021 +0200 Avoid making backup files in ediff when `make-backup-files' is nil * lisp/vc/ediff-util.el (ediff-arrange-autosave-in-merge-jobs): Don't make backup files when `make-backup-files' is nil (bug#21599). diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index b2b92b17e2..0cbea2c28d 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -563,8 +563,9 @@ to invocation.") (set-visited-file-name merge-buffer-file)))) (ediff-with-current-buffer ediff-buffer-C (setq buffer-offer-save t) ; ask before killing buffer - ;; make sure the contents is auto-saved - (auto-save-mode 1)) + (when make-backup-files + ;; make sure the contents is auto-saved + (auto-save-mode 1))) )) commit de5ae0c964135dd3b1247b91b76a6581b5d8a47c Author: Lars Ingebrigtsen Date: Thu Jul 8 15:25:34 2021 +0200 Make ido-mode override ffap-file-finder * lisp/ffap.el: Autoload so that we can override in ido (bug#21980). * lisp/ido.el (ido-everywhere): Override ffap-file-finder. diff --git a/etc/NEWS b/etc/NEWS index b9522c069d..da5524a555 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2410,12 +2410,6 @@ leak information from the reporting user. *** 'count-windows' now takes an optional parameter ALL-FRAMES. The semantics are as with 'walk-windows'. ---- -*** Killing virtual ido buffers interactively will make them go away. -Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't -do anything. This has now been changed, and killing virtual buffers -with that command will remove the buffer from recentf. - --- *** New variable 'ffap-file-name-with-spaces'. If non-nil, 'find-file-at-point' and friends will try to guess more @@ -2490,6 +2484,17 @@ height of lines or width of chars. When non-nil, use a new xwidget webkit session after bookmark jump. Otherwise, it will use 'xwidget-webkit-last-session'. +** ido + +--- +*** Switching on 'ido-mode' now also overrides 'ffap-file-finder'. + +--- +*** Killing virtual ido buffers interactively will make them go away. +Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't +do anything. This has now been changed, and killing virtual buffers +with that command will remove the buffer from recentf. + ** Flymake mode +++ diff --git a/lisp/ffap.el b/lisp/ffap.el index 6faf8d50b2..c31926eb29 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -260,6 +260,7 @@ ffap most of the time." :type 'boolean :group 'ffap) +;;;###autoload (defcustom ffap-file-finder 'find-file "The command called by `find-file-at-point' to find a file." :type 'function diff --git a/lisp/ido.el b/lisp/ido.el index 9362904680..ea5ff32b8d 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1521,6 +1521,10 @@ Removes badly formatted data and ignored directories." :global t (remove-function read-file-name-function #'ido-read-file-name) (remove-function read-buffer-function #'ido-read-buffer) + (when (boundp 'ffap-file-finder) + (remove-function ffap-file-finder #'ido-find-file) + (when ido-mode + (add-function :override ffap-file-finder #'ido-find-file))) (when ido-everywhere (if (not ido-mode) (ido-mode 'both) commit c13acf8e346894304921548a9d310c9d80a20d22 Author: Eli Zaretskii Date: Thu Jul 8 09:51:02 2021 +0300 ; * doc/emacs/mule.texi (International Chars): Mention 'describe-char'. diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 93c5245f6a..e626fb3752 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -174,8 +174,10 @@ characters in the range @code{#x0080..#x00FF}. @cindex font of character at point @cindex text properties at point @cindex face at point - With a prefix argument (@kbd{C-u C-x =}), this command displays a -detailed description of the character in a window: +@findex describe-char + With a prefix argument (@kbd{C-u C-x =}), this command additionally +calls the command @code{describe-char}, which displays a detailed +description of the character: @itemize @bullet @item commit 6d580b00e48e567ac92645e2d120769475d196ad Author: Michael Albinus Date: Thu Jul 8 07:48:40 2021 +0200 Some further adaptions wrt Tramp file name locks * lisp/files.el (files--transform-file-name): Rename from `auto-save--transform-file-name'. Wrap with `save-match-data'. (make-auto-save-file-name): Use it. (make-lock-file-name): Use it. Call file name handler. * lisp/net/tramp.el (tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): Suppress file lock for temporary file. * lisp/net/tramp-compat.el (tramp-compat-make-lock-file-name): New defalias. * lisp/net/tramp.el (tramp-get-lock-file) (tramp-handle-lock-file, tramp-handle-unlock-file): Use it. (tramp-make-lock-name): Remove. * test/lisp/filenotify-tests.el (file-notify-test03-events-remote): Tag it :unstable temporarily. diff --git a/lisp/files.el b/lisp/files.el index c1377320b3..da8598f150 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6679,12 +6679,12 @@ Does not consider `auto-save-visited-file-name' as that variable is checked before calling this function. See also `auto-save-file-name-p'." (if buffer-file-name - (let ((handler (find-file-name-handler buffer-file-name - 'make-auto-save-file-name))) + (let ((handler (find-file-name-handler + buffer-file-name 'make-auto-save-file-name))) (if handler (funcall handler 'make-auto-save-file-name) - (auto-save--transform-file-name buffer-file-name - auto-save-file-name-transforms + (files--transform-file-name + buffer-file-name auto-save-file-name-transforms "#" "#"))) ;; Deal with buffers that don't have any associated files. (Mail ;; mode tends to create a good number of these.) @@ -6735,73 +6735,73 @@ See also `auto-save-file-name-p'." (file-error nil)) file-name))) -(defun auto-save--transform-file-name (filename transforms - prefix suffix) +(defun files--transform-file-name (filename transforms prefix suffix) "Transform FILENAME according to TRANSFORMS. See `auto-save-file-name-transforms' for the format of TRANSFORMS. PREFIX is prepended to the non-directory portion of the resulting file name, and SUFFIX is appended." - (let (result uniq) - ;; Apply user-specified translations - ;; to the file name. - (while (and transforms (not result)) - (if (string-match (car (car transforms)) filename) - (setq result (replace-match (cadr (car transforms)) t nil - filename) - uniq (car (cddr (car transforms))))) - (setq transforms (cdr transforms))) - (when result - (setq filename - (cond - ((memq uniq (secure-hash-algorithms)) - (concat - (file-name-directory result) - (secure-hash uniq filename))) - (uniq - (concat - (file-name-directory result) - (subst-char-in-string - ?/ ?! - (replace-regexp-in-string - "!" "!!" filename)))) - (t result)))) - (setq result - (if (and (eq system-type 'ms-dos) - (not (msdos-long-file-names))) - ;; We truncate the file name to DOS 8+3 limits - ;; before doing anything else, because the regexp - ;; passed to string-match below cannot handle - ;; extensions longer than 3 characters, multiple - ;; dots, and other atrocities. - (let ((fn (dos-8+3-filename - (file-name-nondirectory buffer-file-name)))) - (string-match - "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" - fn) - (concat (file-name-directory buffer-file-name) - prefix (match-string 1 fn) - "." (match-string 3 fn) suffix)) - (concat (file-name-directory filename) - prefix - (file-name-nondirectory filename) - suffix))) - ;; Make sure auto-save file names don't contain characters - ;; invalid for the underlying filesystem. - (expand-file-name - (if (and (memq system-type '(ms-dos windows-nt cygwin)) - ;; Don't modify remote filenames - (not (file-remote-p result))) - (convert-standard-filename result) - result)))) + (save-match-data + (let (result uniq) + ;; Apply user-specified translations to the file name. + (while (and transforms (not result)) + (if (string-match (car (car transforms)) filename) + (setq result (replace-match (cadr (car transforms)) t nil + filename) + uniq (car (cddr (car transforms))))) + (setq transforms (cdr transforms))) + (when result + (setq filename + (cond + ((memq uniq (secure-hash-algorithms)) + (concat + (file-name-directory result) + (secure-hash uniq filename))) + (uniq + (concat + (file-name-directory result) + (subst-char-in-string + ?/ ?! + (replace-regexp-in-string + "!" "!!" filename)))) + (t result)))) + (setq result + (if (and (eq system-type 'ms-dos) + (not (msdos-long-file-names))) + ;; We truncate the file name to DOS 8+3 limits before + ;; doing anything else, because the regexp passed to + ;; string-match below cannot handle extensions longer + ;; than 3 characters, multiple dots, and other + ;; atrocities. + (let ((fn (dos-8+3-filename + (file-name-nondirectory buffer-file-name)))) + (string-match + "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" + fn) + (concat (file-name-directory buffer-file-name) + prefix (match-string 1 fn) + "." (match-string 3 fn) suffix)) + (concat (file-name-directory filename) + prefix + (file-name-nondirectory filename) + suffix))) + ;; Make sure auto-save file names don't contain characters + ;; invalid for the underlying filesystem. + (expand-file-name + (if (and (memq system-type '(ms-dos windows-nt cygwin)) + ;; Don't modify remote filenames + (not (file-remote-p result))) + (convert-standard-filename result) + result))))) (defun make-lock-file-name (filename) "Make a lock file name for FILENAME. By default, this just prepends \".*\" to the non-directory part of FILENAME, but the transforms in `lock-file-name-transforms' are done first." - (save-match-data - (auto-save--transform-file-name - filename lock-file-name-transforms ".#" ""))) + (let ((handler (find-file-name-handler filename 'make-lock-file-name))) + (if handler + (funcall handler 'make-lock-file-name filename) + (files--transform-file-name filename lock-file-name-transforms ".#" "")))) (defun auto-save-file-name-p (filename) "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 9c1c8aca1c..2bd1367145 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -564,7 +564,8 @@ But handle the case, if the \"test\" command is not available." (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok) (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600))) - (write-region start end tmpfile append 'no-message) + (let (create-lockfiles) + (write-region start end tmpfile append 'no-message)) (with-tramp-progress-reporter v 3 (format-message "Moving tmp file `%s' to `%s'" tmpfile filename) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 54cfb6fb4a..9d5e5f787b 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -353,6 +353,16 @@ A nil value for either argument stands for the current time." (lambda (fromstring tostring instring) (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) +;; Function `make-lock-file-name' is new in Emacs 28.1. +(defalias 'tramp-compat-make-lock-file-name + (if (fboundp 'make-lock-file-name) + #'make-lock-file-name + (lambda (filename) + (expand-file-name + (concat + ".#" (file-name-nondirectory filename)) + (file-name-directory filename))))) + (dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) (put (intern elt) 'tramp-suppress-trace t)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1103722779..c65800bb0e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3274,7 +3274,9 @@ implementation will be used." (or (file-directory-p localname) (file-writable-p localname))))) ;; Short track: if we are on the local host, we can run directly. - (write-region start end localname append 'no-message) + (write-region + start end localname append 'no-message + (and lockname (file-local-name lockname))) (let* ((modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) @@ -3308,7 +3310,8 @@ implementation will be used." ;; on. We must ensure that `file-coding-system-alist' ;; matches `tmpfile'. (let ((file-coding-system-alist - (tramp-find-file-name-coding-system-alist filename tmpfile))) + (tramp-find-file-name-coding-system-alist filename tmpfile)) + create-lockfiles) (condition-case err (write-region start end tmpfile append 'no-message) ((error quit) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 500245b3e1..01192db920 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1606,7 +1606,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." ;; We say `no-message' here because we don't want the visited file ;; modtime data to be clobbered from the temp file. We call ;; `set-visited-file-modtime' ourselves later on. - (write-region start end tmpfile append 'no-message) + (let (create-lockfiles) + (write-region start end tmpfile append 'no-message)) (with-tramp-progress-reporter v 3 (format "Moving tmp file %s to %s" tmpfile filename) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 37d60e854f..e9e08265fe 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3818,15 +3818,10 @@ User is always nil." ;; Result. (cons (expand-file-name filename) (cdr result))))) -(defun tramp-make-lock-name (file) - "Implement MAKE_LOCK_NAME of filelock.c." - (expand-file-name - (concat ".#" (file-name-nondirectory file)) (file-name-directory file))) - (defun tramp-get-lock-file (file) "Read lockfile of FILE. Return nil when there is no lockfile" - (let ((lockname (tramp-make-lock-name file))) + (let ((lockname (tramp-compat-make-lock-file-name file))) (or (file-symlink-p lockname) (and (file-readable-p lockname) (with-temp-buffer @@ -3873,7 +3868,7 @@ Return nil when there is no lockfile" (match-string 2 contents) (match-string 3 contents))) (throw 'dont-lock nil))) - (let ((lockname (tramp-make-lock-name file)) + (let ((lockname (tramp-compat-make-lock-file-name file)) ;; USER@HOST.PID[:BOOT_TIME] (contents (format @@ -3886,7 +3881,8 @@ Return nil when there is no lockfile" (defun tramp-handle-unlock-file (file) "Like `unlock-file' for Tramp files." - (delete-file (tramp-make-lock-name file))) + (ignore-errors + (delete-file (tramp-compat-make-lock-file-name file)))) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." @@ -4470,7 +4466,8 @@ of." ;; We say `no-message' here because we don't want the visited file ;; modtime data to be clobbered from the temp file. We call ;; `set-visited-file-modtime' ourselves later on. - (write-region start end tmpfile append 'no-message) + (let (create-lockfiles) + (write-region start end tmpfile append 'no-message)) (condition-case nil (rename-file tmpfile filename 'ok-if-already-exists) (error diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index e0fa66a5d9..6125069c6b 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -927,7 +927,7 @@ delivered." (file-notify--test-cleanup))) (file-notify--deftest-remote file-notify-test03-events - "Check file creation/change/removal notifications for remote files.") + "Check file creation/change/removal notifications for remote files." t) (require 'autorevert) (setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" commit 7d6d14023a4ad7907c6e10ebdb49d78f9c6393e4 Author: Lars Ingebrigtsen Date: Thu Jul 8 03:23:46 2021 +0200 Exclude term-mode from hi-lock global modes * lisp/hi-lock.el (hi-lock-exclude-modes): Exclude term-mode so that `C-x' works in terminal buffers (bug#22620). diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 68f8cc5054..37b88b318d 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -111,7 +111,7 @@ highlighting will be applied throughout the buffer." :group 'hi-lock) (defcustom hi-lock-exclude-modes - '(rmail-mode mime/viewer-mode gnus-article-mode) + '(rmail-mode mime/viewer-mode gnus-article-mode term-mode) "List of major modes in which hi-lock will not run. For security reasons since font lock patterns can specify function calls." commit a45906ac1a973fb8b7141e1e9a5e78ce19692dda Author: Lars Ingebrigtsen Date: Thu Jul 8 02:57:46 2021 +0200 Fix font-lock of Makefile variables at the start of lines * lisp/progmodes/make-mode.el (makefile-var-use-regex): Match variables at the beginning of lines correctly (bug#23266). Change suggested by Anders Lindgren . diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 3f466e1150..4d277755ae 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -272,7 +272,7 @@ not be enclosed in { } or ( )." "Regex used to find macro assignment lines in a makefile.") (defconst makefile-var-use-regex - "[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\|[@% Date: Thu Jul 8 02:43:20 2021 +0200 Mention what happens with timers when the computer is asleep * doc/lispref/os.texi (Timers): Explain what happens if the computer is a asleep when the timer is scheduled (bug#23929). diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 242c5ed152..12ddaf04b6 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2167,6 +2167,11 @@ if @var{time} is @code{t}, then the timer runs whenever the time is a multiple of @var{repeat} seconds after the epoch. This is useful for functions like @code{display-time}. +If Emacs didn't get any CPU time when the timer would have run (for +example if the system was busy running another process or if the +computer was sleeping or in a suspended state), the timer will run as +soon as Emacs resumes and is idle. + The function @code{run-at-time} returns a timer value that identifies the particular scheduled future action. You can use this value to call @code{cancel-timer} (see below). commit e762864b9d501cfbc15fd20f403fc435bbdc580e Author: Lars Ingebrigtsen Date: Wed Jul 7 22:15:42 2021 +0200 Make make_lock_file_name more robust * src/filelock.c (make_lock_file_name): Protect against the make-lock-file-name not being defined. (lock_file, unlock_file_body, Ffile_locked_p): Return early if not defined. diff --git a/src/filelock.c b/src/filelock.c index 99803ccff7..20916ace50 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -622,7 +622,10 @@ lock_if_free (lock_info_type *clasher, char *lfname) static Lisp_Object make_lock_file_name (Lisp_Object fn) { - return call1 (intern ("make-lock-file-name"), Fexpand_file_name (fn, Qnil)); + Lisp_Object func = intern ("make-lock-file-name"); + if (NILP (Fboundp (func))) + return Qnil; + return call1 (func, Fexpand_file_name (fn, Qnil)); } /* lock_file locks file FN, @@ -663,6 +666,8 @@ lock_file (Lisp_Object fn) } Lisp_Object lock_filename = make_lock_file_name (fn); + if (NILP (lock_filename)) + return; char *lfname = SSDATA (ENCODE_FILE (lock_filename)); /* See if this file is visited and has changed on disk since it was @@ -715,6 +720,8 @@ unlock_file_body (Lisp_Object fn) } Lisp_Object lock_filename = make_lock_file_name (fn); + if (NILP (lock_filename)) + return Qnil; lfname = SSDATA (ENCODE_FILE (lock_filename)); int err = current_lock_owner (0, lfname); @@ -859,6 +866,8 @@ t if it is locked by you, else a string saying which user has locked it. */) } Lisp_Object lock_filename = make_lock_file_name (filename); + if (NILP (lock_filename)) + return Qnil; char *lfname = SSDATA (ENCODE_FILE (lock_filename)); owner = current_lock_owner (&locker, lfname); commit fadfc55db1179712049077b2c195669687bf54dd Author: Eli Zaretskii Date: Wed Jul 7 23:10:52 2021 +0300 * lisp/faces.el: Fix a typo. diff --git a/lisp/faces.el b/lisp/faces.el index a0a47a5cac..af2f37df96 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2915,7 +2915,7 @@ It is used for characters of no fonts too." (defface tty-menu-enabled-face '((((class color)) :foreground "yellow" :background "blue" :weight bold) - t :weight bold) + (t :weight bold)) "Face for displaying enabled items in TTY menus." :group 'basic-faces :version "28.1") @@ -2925,7 +2925,7 @@ It is used for characters of no fonts too." :foreground "lightgray" :background "blue") (((class color)) :foreground "white" :background "blue") - t :inherit shadow) + (t :inherit shadow)) "Face for displaying disabled items in TTY menus." :group 'basic-faces :version "28.1") commit 9034dd053163d6fc383d1ea4223c0b4dd7e9fb39 Author: Eli Zaretskii Date: Wed Jul 7 22:53:28 2021 +0300 Fix last change * lisp/faces.el (tty-menu-enabled-face, tty-menu-disabled-face): Define for monochrome displays. diff --git a/lisp/faces.el b/lisp/faces.el index 9c818d5136..a0a47a5cac 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2913,18 +2913,22 @@ It is used for characters of no fonts too." ;; Faces for TTY menus. (defface tty-menu-enabled-face - '((t - :foreground "yellow" :background "blue" :weight bold)) + '((((class color)) + :foreground "yellow" :background "blue" :weight bold) + t :weight bold) "Face for displaying enabled items in TTY menus." - :group 'basic-faces) + :group 'basic-faces + :version "28.1") (defface tty-menu-disabled-face '((((class color) (min-colors 16)) :foreground "lightgray" :background "blue") - (t - :foreground "white" :background "blue")) + (((class color)) + :foreground "white" :background "blue") + t :inherit shadow) "Face for displaying disabled items in TTY menus." - :group 'basic-faces) + :group 'basic-faces + :version "28.1") (defface tty-menu-selected-face '((((class color)) commit 2ad34bcea4ed686e56078e91d63417480e5642b4 Author: Lars Ingebrigtsen Date: Wed Jul 7 21:39:00 2021 +0200 Add new user option lock-file-name-transforms * doc/emacs/files.texi (Interlocking): Mention lock-file-name-transforms. * doc/lispref/files.texi (File Locks): Document lock-file-name-transforms. * doc/misc/efaq.texi (Not writing files to the current directory): Mention all the three variables needed to not having Emacs writing files to the current directory in one place. * lisp/files.el (lock-file-name-transforms): New user option (bug#49261). (make-auto-save-file-name): Factor out the main logic... (auto-save--transform-file-name): ... to this new function. (make-lock-file-name): New function that also calls the factored-out function. * src/filelock.c: Remove MAKE_LOCK_NAME and fill_in_lock_file_name. (make_lock_file_name): New utility function that calls out to Lisp to heed `lock-file-name-transforms'. (lock_file): Use it. Also remove likely buggy call to dostounix_filename. (unlock_file_body, Ffile_locked_p): Also use make_lock_file_name. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 912980b688..98b6b194d2 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -789,7 +789,9 @@ Emacs buffer visiting it has unsaved changes. @vindex create-lockfiles You can prevent the creation of lock files by setting the variable @code{create-lockfiles} to @code{nil}. @strong{Caution:} by -doing so you will lose the benefits that this feature provides. +doing so you will lose the benefits that this feature provides. You +can also control where lock files are written by using the +@code{lock-file-name-transforms} variable. @cindex collision If you begin to modify the buffer while the visited file is locked by diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index ae763a21af..fe3affeef3 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -772,6 +772,20 @@ and otherwise ignores the error. If this variable is @code{nil}, Emacs does not lock files. @end defopt +@defopt lock-file-name-transforms +By default, Emacs creates the lock files in the same directory as the +files that are being locked. This can be changed by customizing this +variable. Is has the same syntax as +@code{auto-save-file-name-transforms} (@pxref{Auto-Saving}). For +instance, to make Emacs write all the lock files to @file{/var/tmp/}, +you could say something like: + +@lisp +(setq lock-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))) +@end lisp +@end defopt + @defun ask-user-about-lock file other-user This function is called when the user tries to modify @var{file}, but it is locked by another user named @var{other-user}. The default diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 53a3af4b78..d66c12f9fc 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -1519,6 +1519,7 @@ of files from Macintosh, Microsoft, and Unix platforms. * Documentation for etags:: * Disabling backups:: * Disabling auto-save-mode:: +* Not writing files to the current directory:: * Going to a line by number:: * Modifying pull-down menus:: * Deleting menus and menu options:: @@ -2620,6 +2621,39 @@ such as @file{/tmp}. To disable or change how @code{auto-save-mode} works, @pxref{Auto Save,,, emacs, The GNU Emacs Manual}. +@node Not writing files to the current directory +@section Making Emacs write all auxiliary files somewhere else +@cindex Writing all auxiliary files to the same directory + +By default, Emacs may create many new files in the directory where +you're editing a file. If you're editing the file +@file{/home/user/foo.txt}, Emacs will create the lock file +@file{/home/user/.#foo.txt}, the auto-save file +@file{/home/user/#foo.txt#}, and when you save the file, Emacs will +create the backup file @file{/home/user/foo.txt~}. (The first two +files are deleted when you save the file.) + +This may be inconvenient in some setups, so Emacs has mechanisms for +changing the locations of all these files. + +@table @code +@item auto-save-file-name-transforms (@pxref{Auto-Saving,,,elisp, GNU Emacs Lisp Reference Manual}). +@item lock-file-name-transforms (@pxref{File Locks,,,elisp, GNU Emacs Lisp Reference Manual}). +@item backup-directory-alist (@pxref{Making Backups,,,elisp, GNU Emacs Lisp Reference Manual}). +@end table + +For instance, to write all these things to +@file{~/.emacs.d/aux/}: + +@lisp +(setq lock-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t))) +(setq auto-save-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t))) +(setq backup-directory-alist + '((".*" . "~/.emacs.d/aux/"))) +@end lisp + @node Going to a line by number @section How can I go to a certain line given its number? @cindex Going to a line by number diff --git a/etc/NEWS b/etc/NEWS index 0e8a846408..b9522c069d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2169,6 +2169,11 @@ summaries will include the failing condition. ** Miscellaneous ++++ +*** New user option 'lock-file-name-transforms'. +This option allows controlling where lock files are written. It uses +the same syntax as 'auto-save-file-name-transforms'. + +++ *** New user option 'kill-transform-function'. This can be used to transform (and suppress) strings from entering the diff --git a/lisp/files.el b/lisp/files.el index 859c193db9..c1377320b3 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -412,6 +412,21 @@ ignored." :initialize 'custom-initialize-delay :version "21.1") +(defcustom lock-file-name-transforms nil + "Transforms to apply to buffer file name before making a lock file name. +This has the same syntax as +`auto-save-file-name-transforms' (which see), but instead of +applying to auto-save file names, it's applied to lock file names. + +By default, a lock file is put into the same directory as the +file it's locking, and it has the same name, but with \".#\" prepended." + :group 'files + :type '(repeat (list (regexp :tag "Regexp") + (string :tag "Replacement") + (boolean :tag "Uniquify"))) + :initialize 'custom-initialize-delay + :version "28.1") + (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.") (defcustom auto-save-visited-interval 5 @@ -6668,63 +6683,11 @@ See also `auto-save-file-name-p'." 'make-auto-save-file-name))) (if handler (funcall handler 'make-auto-save-file-name) - (let ((list auto-save-file-name-transforms) - (filename buffer-file-name) - result uniq) - ;; Apply user-specified translations - ;; to the file name. - (while (and list (not result)) - (if (string-match (car (car list)) filename) - (setq result (replace-match (cadr (car list)) t nil - filename) - uniq (car (cddr (car list))))) - (setq list (cdr list))) - (if result - (setq filename - (cond - ((memq uniq (secure-hash-algorithms)) - (concat - (file-name-directory result) - (secure-hash uniq filename))) - (uniq - (concat - (file-name-directory result) - (subst-char-in-string - ?/ ?! - (replace-regexp-in-string - "!" "!!" filename)))) - (t result)))) - (setq result - (if (and (eq system-type 'ms-dos) - (not (msdos-long-file-names))) - ;; We truncate the file name to DOS 8+3 limits - ;; before doing anything else, because the regexp - ;; passed to string-match below cannot handle - ;; extensions longer than 3 characters, multiple - ;; dots, and other atrocities. - (let ((fn (dos-8+3-filename - (file-name-nondirectory buffer-file-name)))) - (string-match - "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" - fn) - (concat (file-name-directory buffer-file-name) - "#" (match-string 1 fn) - "." (match-string 3 fn) "#")) - (concat (file-name-directory filename) - "#" - (file-name-nondirectory filename) - "#"))) - ;; Make sure auto-save file names don't contain characters - ;; invalid for the underlying filesystem. - (if (and (memq system-type '(ms-dos windows-nt cygwin)) - ;; Don't modify remote filenames - (not (file-remote-p result))) - (convert-standard-filename result) - result)))) - + (auto-save--transform-file-name buffer-file-name + auto-save-file-name-transforms + "#" "#"))) ;; Deal with buffers that don't have any associated files. (Mail ;; mode tends to create a good number of these.) - (let ((buffer-name (buffer-name)) (limit 0) file-name) @@ -6772,6 +6735,74 @@ See also `auto-save-file-name-p'." (file-error nil)) file-name))) +(defun auto-save--transform-file-name (filename transforms + prefix suffix) + "Transform FILENAME according to TRANSFORMS. +See `auto-save-file-name-transforms' for the format of +TRANSFORMS. PREFIX is prepended to the non-directory portion of +the resulting file name, and SUFFIX is appended." + (let (result uniq) + ;; Apply user-specified translations + ;; to the file name. + (while (and transforms (not result)) + (if (string-match (car (car transforms)) filename) + (setq result (replace-match (cadr (car transforms)) t nil + filename) + uniq (car (cddr (car transforms))))) + (setq transforms (cdr transforms))) + (when result + (setq filename + (cond + ((memq uniq (secure-hash-algorithms)) + (concat + (file-name-directory result) + (secure-hash uniq filename))) + (uniq + (concat + (file-name-directory result) + (subst-char-in-string + ?/ ?! + (replace-regexp-in-string + "!" "!!" filename)))) + (t result)))) + (setq result + (if (and (eq system-type 'ms-dos) + (not (msdos-long-file-names))) + ;; We truncate the file name to DOS 8+3 limits + ;; before doing anything else, because the regexp + ;; passed to string-match below cannot handle + ;; extensions longer than 3 characters, multiple + ;; dots, and other atrocities. + (let ((fn (dos-8+3-filename + (file-name-nondirectory buffer-file-name)))) + (string-match + "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" + fn) + (concat (file-name-directory buffer-file-name) + prefix (match-string 1 fn) + "." (match-string 3 fn) suffix)) + (concat (file-name-directory filename) + prefix + (file-name-nondirectory filename) + suffix))) + ;; Make sure auto-save file names don't contain characters + ;; invalid for the underlying filesystem. + (expand-file-name + (if (and (memq system-type '(ms-dos windows-nt cygwin)) + ;; Don't modify remote filenames + (not (file-remote-p result))) + (convert-standard-filename result) + result)))) + +(defun make-lock-file-name (filename) + "Make a lock file name for FILENAME. +By default, this just prepends \".*\" to the non-directory part +of FILENAME, but the transforms in `lock-file-name-transforms' +are done first." + (save-match-data + (auto-save--transform-file-name + filename lock-file-name-transforms ".#" ""))) + (defun auto-save-file-name-p (filename) "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. diff --git a/src/filelock.c b/src/filelock.c index dcdc635c25..99803ccff7 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -51,7 +51,6 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT #include #include /* for fcntl */ -#include "w32.h" /* for dostounix_filename */ #endif #ifndef MSDOS @@ -294,25 +293,6 @@ typedef struct char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."]; } lock_info_type; -/* Write the name of the lock file for FNAME into LOCKNAME. Length - will be that of FNAME plus two more for the leading ".#", plus one - for the null. */ -#define MAKE_LOCK_NAME(lockname, fname) \ - (lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \ - fill_in_lock_file_name (lockname, fname)) - -static void -fill_in_lock_file_name (char *lockfile, Lisp_Object fn) -{ - char *last_slash = memrchr (SSDATA (fn), '/', SBYTES (fn)); - char *base = last_slash + 1; - ptrdiff_t dirlen = base - SSDATA (fn); - memcpy (lockfile, SSDATA (fn), dirlen); - lockfile[dirlen] = '.'; - lockfile[dirlen + 1] = '#'; - strcpy (lockfile + dirlen + 2, base); -} - /* For some reason Linux kernels return EPERM on file systems that do not support hard or symbolic links. This symbol documents the quirk. There is no way to tell whether a symlink call fails due to @@ -639,6 +619,12 @@ lock_if_free (lock_info_type *clasher, char *lfname) return err; } +static Lisp_Object +make_lock_file_name (Lisp_Object fn) +{ + return call1 (intern ("make-lock-file-name"), Fexpand_file_name (fn, Qnil)); +} + /* lock_file locks file FN, meaning it serves notice on the world that you intend to edit that file. This should be done only when about to modify a file-visiting @@ -660,10 +646,7 @@ lock_if_free (lock_info_type *clasher, char *lfname) void lock_file (Lisp_Object fn) { - Lisp_Object orig_fn, encoded_fn; - char *lfname = NULL; lock_info_type lock_info; - USE_SAFE_ALLOCA; /* Don't do locking while dumping Emacs. Uncompressing wtmp files uses call-process, which does not work @@ -671,8 +654,6 @@ lock_file (Lisp_Object fn) if (will_dump_p ()) return; - /* If the file name has special constructs in it, - call the corresponding file name handler. */ Lisp_Object handler; handler = Ffind_file_name_handler (fn, Qlock_file); if (!NILP (handler)) @@ -681,30 +662,20 @@ lock_file (Lisp_Object fn) return; } - orig_fn = fn; - fn = Fexpand_file_name (fn, Qnil); -#ifdef WINDOWSNT - /* Ensure we have only '/' separators, to avoid problems with - looking (inside fill_in_lock_file_name) for backslashes in file - names encoded by some DBCS codepage. */ - dostounix_filename (SSDATA (fn)); -#endif - encoded_fn = ENCODE_FILE (fn); - if (create_lockfiles) - /* Create the name of the lock-file for file fn */ - MAKE_LOCK_NAME (lfname, encoded_fn); + Lisp_Object lock_filename = make_lock_file_name (fn); + char *lfname = SSDATA (ENCODE_FILE (lock_filename)); /* See if this file is visited and has changed on disk since it was visited. */ - Lisp_Object subject_buf = get_truename_buffer (orig_fn); + Lisp_Object subject_buf = get_truename_buffer (fn); if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) - && !NILP (Ffile_exists_p (fn)) - && !(lfname && current_lock_owner (NULL, lfname) == -2)) + && !NILP (Ffile_exists_p (lock_filename)) + && !(create_lockfiles && current_lock_owner (NULL, lfname) == -2)) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); /* Don't do locking if the user has opted out. */ - if (lfname) + if (create_lockfiles) { /* Try to lock the lock. FIXME: This ignores errors when lock_if_free returns a positive errno value. */ @@ -725,7 +696,6 @@ lock_file (Lisp_Object fn) if (!NILP (attack)) lock_file_1 (lfname, 1); } - SAFE_FREE (); } } @@ -733,7 +703,6 @@ static Lisp_Object unlock_file_body (Lisp_Object fn) { char *lfname; - USE_SAFE_ALLOCA; /* If the file name has special constructs in it, call the corresponding file name handler. */ @@ -745,18 +714,15 @@ unlock_file_body (Lisp_Object fn) return Qnil; } - Lisp_Object filename = Fexpand_file_name (fn, Qnil); - fn = ENCODE_FILE (filename); - - MAKE_LOCK_NAME (lfname, fn); + Lisp_Object lock_filename = make_lock_file_name (fn); + lfname = SSDATA (ENCODE_FILE (lock_filename)); int err = current_lock_owner (0, lfname); if (err == -2 && unlink (lfname) != 0 && errno != ENOENT) err = errno; if (0 < err) - report_file_errno ("Unlocking file", filename, err); + report_file_errno ("Unlocking file", fn, err); - SAFE_FREE (); return Qnil; } @@ -880,10 +846,8 @@ t if it is locked by you, else a string saying which user has locked it. */) return Qnil; #else Lisp_Object ret; - char *lfname; int owner; lock_info_type locker; - USE_SAFE_ALLOCA; /* If the file name has special constructs in it, call the corresponding file name handler. */ @@ -894,9 +858,8 @@ t if it is locked by you, else a string saying which user has locked it. */) return call2 (handler, Qfile_locked_p, filename); } - filename = Fexpand_file_name (filename, Qnil); - Lisp_Object encoded_filename = ENCODE_FILE (filename); - MAKE_LOCK_NAME (lfname, encoded_filename); + Lisp_Object lock_filename = make_lock_file_name (filename); + char *lfname = SSDATA (ENCODE_FILE (lock_filename)); owner = current_lock_owner (&locker, lfname); switch (owner) @@ -907,7 +870,6 @@ t if it is locked by you, else a string saying which user has locked it. */) default: report_file_errno ("Testing file lock", filename, owner); } - SAFE_FREE (); return ret; #endif } diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 257cbc2d32..a6b0c900be 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -949,6 +949,44 @@ unquoted file names." (make-auto-save-file-name) (kill-buffer))))))) +(ert-deftest files-test-auto-save-name-default () + (with-temp-buffer + (let ((auto-save-file-name-transforms nil)) + (setq buffer-file-name "/tmp/foo.txt") + (should (equal (make-auto-save-file-name) "/tmp/#foo.txt#"))))) + +(ert-deftest files-test-auto-save-name-transform () + (with-temp-buffer + (setq buffer-file-name "/tmp/foo.txt") + (let ((auto-save-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil)))) + (should (equal (make-auto-save-file-name) "/var/tmp/#foo.txt#"))))) + +(ert-deftest files-test-auto-save-name-unique () + (with-temp-buffer + (setq buffer-file-name "/tmp/foo.txt") + (let ((auto-save-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))) + (should (equal (make-auto-save-file-name) "/var/tmp/#!tmp!foo.txt#"))) + (let ((auto-save-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))) + (should (equal (make-auto-save-file-name) + "/var/tmp/#b57c5a04f429a83305859d3350ecdab8315a9037#"))))) + +(ert-deftest files-test-lock-name-default () + (let ((lock-file-name-transforms nil)) + (should (equal (make-lock-file-name "/tmp/foo.txt") "/tmp/.#foo.txt")))) + +(ert-deftest files-test-lock-name-unique () + (let ((lock-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))) + (should (equal (make-lock-file-name "/tmp/foo.txt") + "/var/tmp/.#!tmp!foo.txt"))) + (let ((lock-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))) + (should (equal (make-lock-file-name "/tmp/foo.txt") + "/var/tmp/.#b57c5a04f429a83305859d3350ecdab8315a9037")))) + (ert-deftest files-tests-file-name-non-special-make-directory () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) (let ((default-directory nospecial-dir)) commit 6d594848e052b1e627479ee1068e147a6aaf1c70 Author: Eli Zaretskii Date: Wed Jul 7 22:36:27 2021 +0300 Fix tty menus on monochrome displays * lisp/faces.el (tty-menu-selected-face): Make sure the selected menu item stands out even without colors. diff --git a/lisp/faces.el b/lisp/faces.el index 308da9367d..9c818d5136 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2927,9 +2927,12 @@ It is used for characters of no fonts too." :group 'basic-faces) (defface tty-menu-selected-face - '((t :background "red")) + '((((class color)) + :background "red") + (t :inverse-video t)) "Face for displaying the currently selected item in TTY menus." - :group 'basic-faces) + :group 'basic-faces + :version "28.1") (defgroup paren-showing-faces nil "Faces used to highlight paren matches." commit d35868bec96718705c9bc8aaac3bc583c837033f Author: Michael Albinus Date: Wed Jul 7 18:36:53 2021 +0200 Implement file locks for remote files (Bug#49261) * doc/lispref/files.texi (Magic File Names): Add file-locked-p, lock-file and unlock-file. * etc/NEWS: Tramp supports file locks now. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-adb-handle-write-region): Handle LOCKNAME. * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-crypt-handle-file-locked-p, tramp-crypt-handle-lock-file) (tramp-crypt-handle-unlock-file): New defun. * lisp/net/tramp-fuse.el (tramp-fuse-mounted-p): Simplify. (tramp-fuse-unmount): New defun. * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-gvfs-maybe-open-connection): Set "lock-pid" connection property. * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-rclone-maybe-open-connection): Set "lock-pid" connection property. * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-sh-handle-write-region): Handle LOCKNAME. * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-smb-handle-copy-directory): Use `sleep-for'. (tramp-smb-handle-write-region): Handle LOCKNAME. * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-sshfs-handle-write-region): Handle LOCKNAME. (tramp-sshfs-maybe-open-connection): Set "lock-pid" connection property. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-sudoedit-maybe-open-connection): Set "lock-pid" connection property. * lisp/net/tramp.el (tramp-file-name-for-operation): Add `file-locked-p', `lock-file' and `unlock-file'. (tramp-make-lock-name, tramp-get-lock-file, tramp-get-lock-pid) (tramp-handle-file-locked-p, tramp-handle-lock-file) (tramp-handle-unlock-file): New defuns. (tramp-lock-file-contents-regexp): New regexp. (tramp-handle-write-region): Handle LOCKNAME. * src/filelock.c (lock_file, unlock_file_body, Ffile_locked_p): Call handler if exists. (Flock_file, Funlock_file): New defuns. (Qlock_file, Qunlock_file, Qfile_locked_p): Declare symbols. (Slock_file, Sunlock_file): Declare subroutines. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test40-make-nearby-temp-file) (tramp-archive-test43-file-system-info): Rename. * test/lisp/net/tramp-tests.el (top): Set `create-lockfiles' to nil. (tramp--test-fuse-p): New defun. (tramp-test14-delete-directory): Use it. (tramp-test39-lock-file): New test. (tramp-test40-make-nearby-temp-file) (tramp-test41-special-characters) (tramp-test41-special-characters-with-stat) (tramp-test41-special-characters-with-perl) (tramp-test41-special-characters-with-ls, tramp-test42-utf8) (tramp-test42-utf8-with-stat, tramp-test42-utf8-with-perl) (tramp-test42-utf8-with-ls, tramp-test43-file-system-info) (tramp-test44-asynchronous-requests, tramp-test45-auto-load) (tramp-test45-delay-load, tramp-test45-recursive-load) (tramp-test45-remote-load-path, tramp-test46-unload): Rename. (tramp--test-special-characters, tramp--test-utf8) (tramp--test-asynchronous-requests-timeout): Modify docstring. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 5238597a46..ae763a21af 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3273,7 +3273,7 @@ first, before handlers for jobs such as remote file access. @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-in-directory-p}, -@code{file-local-copy}, +@code{file-local-copy}, @code{file-locked-p}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-case-insensitive-p}, @@ -3292,7 +3292,7 @@ first, before handlers for jobs such as remote file access. @code{get-file-buffer}, @code{insert-directory}, @code{insert-file-contents},@* -@code{load}, +@code{load}, @code{lock-file}, @code{make-auto-save-file-name}, @code{make-directory}, @code{make-directory-internal}, @@ -3307,6 +3307,7 @@ first, before handlers for jobs such as remote file access. @code{substitute-in-file-name},@* @code{temporary-file-directory}, @code{unhandled-file-name-directory}, +@code{unlock-file}, @code{vc-registered}, @code{verify-visited-file-modtime},@* @code{write-region}. @@ -3331,7 +3332,7 @@ first, before handlers for jobs such as remote file access. @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-in-directory-p}, -@code{file-local-copy}, +@code{file-local-copy}, @code{file-locked-p}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-case-insensitive-p}, @@ -3350,7 +3351,7 @@ first, before handlers for jobs such as remote file access. @code{get-file-buffer}, @code{insert-directory}, @code{insert-file-contents}, -@code{load}, +@code{load}, @code{lock-file}, @code{make-auto-save-file-name}, @code{make-direc@discretionary{}{}{}tory}, @code{make-direc@discretionary{}{}{}tory-internal}, @@ -3363,6 +3364,7 @@ first, before handlers for jobs such as remote file access. @code{start-file-process}, @code{substitute-in-file-name}, @code{unhandled-file-name-directory}, +@code{unlock-file}, @code{vc-regis@discretionary{}{}{}tered}, @code{verify-visited-file-modtime}, @code{write-region}. diff --git a/etc/NEWS b/etc/NEWS index 7bf8c1d8f5..0e8a846408 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -323,6 +323,7 @@ emulators by using the new input-meta-mode with the special value ** New frame parameter 'drag-with-tab-line'. This parameter, similar to 'drag-with-header-line', allows moving frames by dragging the tab lines of their topmost windows with the mouse. + * Editing Changes in Emacs 28.1 @@ -1467,6 +1468,9 @@ rare cases) Tramp blocks Emacs, and we need further debug information. directory must be confirmed. In order to suppress this confirmation, set user option 'tramp-allow-unsafe-temporary-files' to t. ++++ +*** Tramp supports file locks now. + ** Tempo --- @@ -2932,7 +2936,7 @@ The former is now declared obsolete. * Lisp Changes in Emacs 28.1 --- -*** :safe settings in 'defcustom' are now propagated to the loaddefs files. +*** ':safe' settings in 'defcustom' are now propagated to the loaddefs files. +++ ** New function 'syntax-class-to-char'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index f9569523d9..9c1c8aca1c 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -133,6 +133,7 @@ It is used for TCP/IP devices." (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-adb-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-adb-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -159,6 +160,7 @@ It is used for TCP/IP devices." (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-adb-handle-make-directory) (make-directory-internal . ignore) @@ -180,6 +182,7 @@ It is used for TCP/IP devices." (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-adb-handle-write-region)) @@ -533,9 +536,10 @@ But handle the case, if the \"test\" command is not available." rw-path))))))) (defun tramp-adb-handle-write-region - (start end filename &optional append visit _lockname mustbenew) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) + (setq filename (expand-file-name filename) + lockname (file-truename (or lockname filename))) (with-parsed-tramp-file-name filename nil (when (and mustbenew (file-exists-p filename) (or (eq mustbenew 'excl) @@ -544,15 +548,26 @@ But handle the case, if the \"test\" command is not available." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let* ((curbuf (current-buffer)) + (let* ((auto-saving + (string-match-p "^#.+#$" (file-name-nondirectory filename))) + file-locked + (curbuf (current-buffer)) (tmpfile (tramp-compat-make-temp-file filename))) + + ;; Lock file. + (when (and (not auto-saving) (file-remote-p lockname) + (not (eq (file-locked-p lockname) t))) + (setq file-locked t) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'lock-file lockname)) + (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok) (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600))) (write-region start end tmpfile append 'no-message) (with-tramp-progress-reporter - v 3 (format-message - "Moving tmp file `%s' to `%s'" tmpfile filename) + v 3 (format-message + "Moving tmp file `%s' to `%s'" tmpfile filename) (unwind-protect (unless (tramp-adb-execute-adb-command v "push" tmpfile (tramp-compat-file-name-unquote localname)) @@ -575,6 +590,11 @@ But handle the case, if the \"test\" command is not available." (file-attributes filename)) (current-time)))) + ;; Unlock file. + (when (and file-locked (eq (file-locked-p lockname) t)) + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + ;; The end. (when (and (null noninteractive) (or (eq visit t) (null visit) (stringp visit))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index d723fd5c6d..a6f479bcbc 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -236,6 +236,7 @@ It must be supported by libarchive(3).") (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-archive-handle-file-local-copy) + (file-locked-p . ignore) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-archive-handle-file-name-all-completions) ;; `file-name-as-directory' performed by default handler. @@ -262,6 +263,7 @@ It must be supported by libarchive(3).") (insert-directory . tramp-archive-handle-insert-directory) (insert-file-contents . tramp-archive-handle-insert-file-contents) (load . tramp-archive-handle-load) + (lock-file . ignore) (make-auto-save-file-name . ignore) (make-directory . tramp-archive-handle-not-implemented) (make-directory-internal . tramp-archive-handle-not-implemented) @@ -283,6 +285,7 @@ It must be supported by libarchive(3).") (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) + (unlock-file . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-archive-handle-not-implemented)) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index a41620ab9f..579234f9f5 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -49,6 +49,8 @@ ;; an open connection. Examples: "scripts" keeps shell script ;; definitions already sent to the remote shell, "last-cmd-time" is ;; the time stamp a command has been sent to the remote process. +;; "lock-pid" is the timestamp a (network) process is created, it is +;; used instead of the pid in file locks. ;; ;; - The key is nil. These are temporary properties related to the ;; local machine. Examples: "parse-passwd" and "parse-group" keep diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 1d8c0ad217..31988bc9ef 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -182,6 +182,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) + (file-locked-p . tramp-crypt-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-crypt-handle-file-name-all-completions) ;; `file-name-as-directory' performed by default handler. @@ -208,6 +209,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (insert-directory . tramp-crypt-handle-insert-directory) ;; `insert-file-contents' performed by default handler. (load . tramp-handle-load) + (lock-file . tramp-crypt-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-crypt-handle-make-directory) (make-directory-internal . ignore) @@ -229,6 +231,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." ;; `tramp-get-remote-uid' performed by default handler. (tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-crypt-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-handle-write-region)) @@ -734,6 +737,11 @@ absolute file names." (let (tramp-crypt-enabled) (file-executable-p (tramp-crypt-encrypt-file-name filename)))) +(defun tramp-crypt-handle-file-locked-p (filename) + "Like `file-locked-p' for Tramp files." + (let (tramp-crypt-enabled) + (file-locked-p (tramp-crypt-encrypt-file-name filename)))) + (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (all-completions @@ -797,6 +805,11 @@ WILDCARD is not supported." (delete-region (prop-match-beginning match) (prop-match-end match)) (insert (propertize string 'dired-filename t))))))) +(defun tramp-crypt-handle-lock-file (filename) + "Like `lock-file' for Tramp files." + (let (tramp-crypt-enabled) + (lock-file (tramp-crypt-encrypt-file-name filename)))) + (defun tramp-crypt-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name dir) nil @@ -848,6 +861,11 @@ WILDCARD is not supported." (tramp-set-file-uid-gid (tramp-crypt-encrypt-file-name filename) uid gid)))) +(defun tramp-crypt-handle-unlock-file (filename) + "Like `unlock-file' for Tramp files." + (let (tramp-crypt-enabled) + (unlock-file (tramp-crypt-encrypt-file-name filename)))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-crypt 'force))) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index ec1db8680f..93b184a36c 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -164,10 +164,9 @@ (or (tramp-get-connection-property (tramp-get-connection-process vec) "mounted" nil) (let* ((default-directory (tramp-compat-temporary-file-directory)) - (fuse (concat "fuse." (tramp-file-name-method vec))) - (mount (shell-command-to-string (format "mount -t %s" fuse)))) - (tramp-message vec 6 "%s %s" "mount -t" fuse) - (tramp-message vec 6 "\n%s" mount) + (command (format "mount -t fuse.%s" (tramp-file-name-method vec))) + (mount (shell-command-to-string command))) + (tramp-message vec 6 "%s\n%s" command mount) (tramp-set-connection-property (tramp-get-connection-process vec) "mounted" (when (string-match @@ -176,6 +175,16 @@ mount) (match-string 1 mount))))))) +(defun tramp-fuse-unmount (vec) + "Unmount fuse volume determined by VEC." + (let ((default-directory (tramp-compat-temporary-file-directory)) + (command (format "fusermount3 -u %s" (tramp-fuse-mount-point vec)))) + (tramp-message vec 6 "%s\n%s" command (shell-command-to-string command)) + (tramp-flush-connection-property + (tramp-get-connection-process vec) "mounted") + ;; Give the caches a chance to expire. + (sleep-for 1))) + (defun tramp-fuse-local-file-name (filename) "Return local mount name of FILENAME." (setq filename (tramp-compat-file-name-unquote (expand-file-name filename))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f1d24dc0c4..e784ea83ef 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -774,6 +774,7 @@ It has been changed in GVFS 1.14.") (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -800,6 +801,7 @@ It has been changed in GVFS 1.14.") (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-gvfs-handle-make-directory) (make-directory-internal . ignore) @@ -821,6 +823,7 @@ It has been changed in GVFS 1.14.") (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-handle-write-region)) @@ -2144,6 +2147,9 @@ connection if a previous connection has died for some reason." (process-put p 'vector vec) (set-process-query-on-exit-flag p nil) + ;; Mark process for filelock. + (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds))) + ;; Set connection-local variables. (tramp-set-connection-local-variables vec))) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 3b6de3e0b7..6c710dd0b1 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -96,6 +96,7 @@ (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-fuse-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -122,6 +123,7 @@ (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-fuse-handle-make-directory) (make-directory-internal . ignore) @@ -143,6 +145,7 @@ (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-handle-write-region)) @@ -358,6 +361,10 @@ connection if a previous connection has died for some reason." (process-put p 'vector vec) (set-process-query-on-exit-flag p nil) + ;; Mark process for filelock. + (tramp-set-connection-property + p "lock-pid" (truncate (time-to-seconds))) + ;; Set connection-local variables. (tramp-set-connection-local-variables vec))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 5f597ff46e..1103722779 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -962,6 +962,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (file-exists-p . tramp-sh-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-sh-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-sh-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -988,6 +989,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (insert-directory . tramp-sh-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sh-handle-make-directory) ;; `make-directory-internal' performed by default handler. @@ -1009,6 +1011,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-handle-unlock-file) (vc-registered . tramp-sh-handle-vc-registered) (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime) (write-region . tramp-sh-handle-write-region)) @@ -3233,9 +3236,10 @@ implementation will be used." tmpfile))) (defun tramp-sh-handle-write-region - (start end filename &optional append visit _lockname mustbenew) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) + (setq filename (expand-file-name filename) + lockname (file-truename (or lockname filename))) (with-parsed-tramp-file-name filename nil (when (and mustbenew (file-exists-p filename) (or (eq mustbenew 'excl) @@ -3244,13 +3248,23 @@ implementation will be used." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((uid (or (tramp-compat-file-attribute-user-id + (let ((auto-saving + (string-match-p "^#.+#$" (file-name-nondirectory filename))) + file-locked + (uid (or (tramp-compat-file-attribute-user-id (file-attributes filename 'integer)) (tramp-get-remote-uid v 'integer))) (gid (or (tramp-compat-file-attribute-group-id (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer)))) + ;; Lock file. + (when (and (not auto-saving) (file-remote-p lockname) + (not (eq (file-locked-p lockname) t))) + (setq file-locked t) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'lock-file lockname)) + (if (and (tramp-local-host-p v) ;; `file-writable-p' calls `file-expand-file-name'. We ;; cannot use `tramp-run-real-handler' therefore. @@ -3465,6 +3479,12 @@ implementation will be used." ;; Set the ownership. (when need-chown (tramp-set-file-uid-gid filename uid gid)) + + ;; Unlock file. + (when (and file-locked (eq (file-locked-p lockname) t)) + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + (when (and (null noninteractive) (or (eq visit t) (null visit) (stringp visit))) (tramp-message v 0 "Wrote %s" filename)) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 13edf16756..500245b3e1 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -247,6 +247,7 @@ See `tramp-actions-before-shell' for more info.") (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-smb-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-smb-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -273,6 +274,7 @@ See `tramp-actions-before-shell' for more info.") (insert-directory . tramp-smb-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-smb-handle-make-directory) (make-directory-internal . tramp-smb-handle-make-directory-internal) @@ -294,6 +296,7 @@ See `tramp-actions-before-shell' for more info.") (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-smb-handle-write-region)) @@ -532,7 +535,7 @@ arguments to pass to the OPERATION." (tramp-process-actions p v nil tramp-smb-actions-with-tar) (while (process-live-p p) - (sit-for 0.1)) + (sleep-for 0.1)) (tramp-message v 6 "\n%s" (buffer-string)))) ;; Reset the transfer process properties. @@ -1573,9 +1576,10 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (error filename)))) (defun tramp-smb-handle-write-region - (start end filename &optional append visit _lockname mustbenew) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) + (setq filename (expand-file-name filename) + lockname (file-truename (or lockname filename))) (with-parsed-tramp-file-name filename nil (when (and mustbenew (file-exists-p filename) (or (eq mustbenew 'excl) @@ -1584,8 +1588,19 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((curbuf (current-buffer)) + (let ((auto-saving + (string-match-p "^#.+#$" (file-name-nondirectory filename))) + file-locked + (curbuf (current-buffer)) (tmpfile (tramp-compat-make-temp-file filename))) + + ;; Lock file. + (when (and (not auto-saving) (file-remote-p lockname) + (not (eq (file-locked-p lockname) t))) + (setq file-locked t) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'lock-file lockname)) + (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; We say `no-message' here because we don't want the visited file @@ -1618,6 +1633,11 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (file-attributes filename)) (current-time)))) + ;; Unlock file. + (when (and file-locked (eq (file-locked-p lockname) t)) + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + ;; The end. (when (and (null noninteractive) (or (eq visit t) (null visit) (stringp visit))) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index cac8c40abb..babd770be9 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -96,6 +96,7 @@ (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-fuse-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -122,6 +123,7 @@ (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-sshfs-handle-insert-file-contents) (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-fuse-handle-make-directory) (make-directory-internal . ignore) @@ -143,6 +145,7 @@ (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-sshfs-handle-write-region)) @@ -279,9 +282,10 @@ arguments to pass to the OPERATION." (tramp-fuse-local-file-name filename) mode flag)))) (defun tramp-sshfs-handle-write-region - (start end filename &optional append visit _lockname mustbenew) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) + (setq filename (expand-file-name filename) + lockname (file-truename (or lockname filename))) (with-parsed-tramp-file-name filename nil (when (and mustbenew (file-exists-p filename) (or (eq mustbenew 'excl) @@ -290,15 +294,32 @@ arguments to pass to the OPERATION." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (write-region - start end (tramp-fuse-local-file-name filename) append 'nomessage) - (tramp-flush-file-properties v localname) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))) + (let ((auto-saving + (string-match-p "^#.+#$" (file-name-nondirectory filename))) + file-locked) + + ;; Lock file. + (when (and (not auto-saving) (file-remote-p lockname) + (not (eq (file-locked-p lockname) t))) + (setq file-locked t) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'lock-file lockname)) + + (let (create-lockfiles) + (write-region + start end (tramp-fuse-local-file-name filename) append 'nomessage) + (tramp-flush-file-properties v localname)) + + ;; Unlock file. + (when (and file-locked (eq (file-locked-p lockname) t)) + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + + ;; The end. + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook)))) ;; File name conversions. @@ -321,6 +342,9 @@ connection if a previous connection has died for some reason." (process-put p 'vector vec) (set-process-query-on-exit-flag p nil) + ;; Mark process for filelock. + (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds))) + ;; Set connection-local variables. (tramp-set-connection-local-variables vec) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index d6417094ba..aa6f85ec6e 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -88,6 +88,7 @@ See `tramp-actions-before-shell' for more info.") (file-exists-p . tramp-sudoedit-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-sudoedit-handle-file-name-all-completions) @@ -115,6 +116,7 @@ See `tramp-actions-before-shell' for more info.") (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sudoedit-handle-make-directory) (make-directory-internal . ignore) @@ -136,6 +138,7 @@ See `tramp-actions-before-shell' for more info.") (tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-sudoedit-handle-write-region)) @@ -713,6 +716,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sudoedit-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." + (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil (let* ((uid (or (tramp-compat-file-attribute-user-id (file-attributes filename 'integer)) @@ -776,6 +780,9 @@ connection if a previous connection has died for some reason." (process-put p 'vector vec) (set-process-query-on-exit-flag p nil) + ;; Mark process for filelock. + (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds))) + ;; Set connection-local variables. (tramp-set-connection-local-variables vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 04ec06d251..37d60e854f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2455,6 +2455,8 @@ Must be handled by the callers." file-name-case-insensitive-p ;; Emacs 27+ only. file-system-info + ;; Emacs 28+ only. + file-locked-p lock-file unlock-file ;; Tramp internal magic file name function. tramp-set-file-uid-gid)) (if (file-name-absolute-p (nth 0 args)) @@ -3816,6 +3818,76 @@ User is always nil." ;; Result. (cons (expand-file-name filename) (cdr result))))) +(defun tramp-make-lock-name (file) + "Implement MAKE_LOCK_NAME of filelock.c." + (expand-file-name + (concat ".#" (file-name-nondirectory file)) (file-name-directory file))) + +(defun tramp-get-lock-file (file) + "Read lockfile of FILE. +Return nil when there is no lockfile" + (let ((lockname (tramp-make-lock-name file))) + (or (file-symlink-p lockname) + (and (file-readable-p lockname) + (with-temp-buffer + (insert-file-contents-literally lockname) + (buffer-string)))))) + +(defun tramp-get-lock-pid (file) + "Determine pid for lockfile of FILE." + ;; Some Tramp methods do not offer a connection process, but just a + ;; network process as a place holder. Those processes use the + ;; "lock-pid" connection property as fake pid, in fact it is the + ;; time stamp the process is created. + (let ((p (tramp-get-process (tramp-dissect-file-name file)))) + (number-to-string + (or (process-id p) + (tramp-get-connection-property p "lock-pid" (emacs-pid)))))) + +(defconst tramp-lock-file-contents-regexp + ;; USER@HOST.PID[:BOOT_TIME] + "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'" + "The format of a lock file.") + +(defun tramp-handle-file-locked-p (file) + "Like `file-locked-p' for Tramp files." + (when-let ((contents (tramp-get-lock-file file)) + (match (string-match tramp-lock-file-contents-regexp contents))) + (or (and (string-equal (match-string 1 contents) (user-login-name)) + (string-equal (match-string 2 contents) (system-name)) + (string-equal (match-string 3 contents) (tramp-get-lock-pid file))) + (match-string 1 contents)))) + +(defun tramp-handle-lock-file (file) + "Like `lock-file' for Tramp files." + ;; See if this file is visited and has changed on disk since it + ;; was visited. + (catch 'dont-lock + (unless (or (null create-lockfiles) + (eq (file-locked-p file) t)) ;; Locked by me. + (when-let ((contents (tramp-get-lock-file file)) + (match (string-match tramp-lock-file-contents-regexp contents))) + (unless (ask-user-about-lock + file (format + "%s@%s (pid %s)" (match-string 1 contents) + (match-string 2 contents) (match-string 3 contents))) + (throw 'dont-lock nil))) + + (let ((lockname (tramp-make-lock-name file)) + ;; USER@HOST.PID[:BOOT_TIME] + (contents + (format + "%s@%s.%s" (user-login-name) (system-name) + (tramp-get-lock-pid file))) + create-lockfiles signal-hook-function) + (condition-case nil + (make-symbolic-link contents lockname 'ok-if-already-exists) + (error (write-region contents nil lockname))))))) + +(defun tramp-handle-unlock-file (file) + "Like `unlock-file' for Tramp files." + (delete-file (tramp-make-lock-name file))) + (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." (with-parsed-tramp-file-name (expand-file-name file) nil @@ -4355,9 +4427,10 @@ of." (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))) (defun tramp-handle-write-region - (start end filename &optional append visit _lockname mustbenew) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) + (setq filename (expand-file-name filename) + lockname (file-truename (or lockname filename))) (with-parsed-tramp-file-name filename nil (when (and mustbenew (file-exists-p filename) (or (eq mustbenew 'excl) @@ -4366,7 +4439,10 @@ of." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((tmpfile (tramp-compat-make-temp-file filename)) + (let ((auto-saving + (string-match-p "^#.+#$" (file-name-nondirectory filename))) + file-locked + (tmpfile (tramp-compat-make-temp-file filename)) (modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) (uid (or (tramp-compat-file-attribute-user-id @@ -4375,6 +4451,14 @@ of." (gid (or (tramp-compat-file-attribute-group-id (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer)))) + + ;; Lock file. + (when (and (not auto-saving) (file-remote-p lockname) + (not (eq (file-locked-p lockname) t))) + (setq file-locked t) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'lock-file lockname)) + (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; The permissions of the temporary file should be set. If @@ -4404,13 +4488,18 @@ of." (current-time)))) ;; Set the ownership. - (tramp-set-file-uid-gid filename uid gid)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))) + (tramp-set-file-uid-gid filename uid gid) + + ;; Unlock file. + (when (and file-locked (eq (file-locked-p lockname) t)) + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + + ;; The end. + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook)))) ;; This is used in tramp-sh.el and tramp-sudoedit.el. (defconst tramp-stat-marker "/////" diff --git a/src/filelock.c b/src/filelock.c index 446a262a1c..dcdc635c25 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -671,6 +671,16 @@ lock_file (Lisp_Object fn) if (will_dump_p ()) return; + /* If the file name has special constructs in it, + call the corresponding file name handler. */ + Lisp_Object handler; + handler = Ffind_file_name_handler (fn, Qlock_file); + if (!NILP (handler)) + { + call2 (handler, Qlock_file, fn); + return; + } + orig_fn = fn; fn = Fexpand_file_name (fn, Qnil); #ifdef WINDOWSNT @@ -725,6 +735,16 @@ unlock_file_body (Lisp_Object fn) char *lfname; USE_SAFE_ALLOCA; + /* If the file name has special constructs in it, + call the corresponding file name handler. */ + Lisp_Object handler; + handler = Ffind_file_name_handler (fn, Qunlock_file); + if (!NILP (handler)) + { + call2 (handler, Qunlock_file, fn); + return Qnil; + } + Lisp_Object filename = Fexpand_file_name (fn, Qnil); fn = ENCODE_FILE (filename); @@ -784,6 +804,27 @@ unlock_all_files (void) } } +DEFUN ("lock-file", Flock_file, Slock_file, + 0, 1, 0, + doc: /* Lock FILE. +If the option `create-lockfiles' is nil, this does nothing. */) + (Lisp_Object file) +{ + CHECK_STRING (file); + lock_file (file); + return Qnil; +} + +DEFUN ("unlock-file", Funlock_file, Sunlock_file, + 0, 1, 0, + doc: /* Unlock FILE. */) + (Lisp_Object file) +{ + CHECK_STRING (file); + unlock_file (file); + return Qnil; +} + DEFUN ("lock-buffer", Flock_buffer, Slock_buffer, 0, 1, 0, doc: /* Lock FILE, if current buffer is modified. @@ -844,6 +885,15 @@ t if it is locked by you, else a string saying which user has locked it. */) lock_info_type locker; USE_SAFE_ALLOCA; + /* If the file name has special constructs in it, + call the corresponding file name handler. */ + Lisp_Object handler; + handler = Ffind_file_name_handler (filename, Qfile_locked_p); + if (!NILP (handler)) + { + return call2 (handler, Qfile_locked_p, filename); + } + filename = Fexpand_file_name (filename, Qnil); Lisp_Object encoded_filename = ENCODE_FILE (filename); MAKE_LOCK_NAME (lfname, encoded_filename); @@ -876,7 +926,13 @@ The name of the (per-buffer) lockfile is constructed by prepending a Info node `(emacs)Interlocking'. */); create_lockfiles = true; - defsubr (&Sunlock_buffer); + DEFSYM (Qlock_file, "lock-file"); + DEFSYM (Qunlock_file, "unlock-file"); + DEFSYM (Qfile_locked_p, "file-locked-p"); + + defsubr (&Slock_file); + defsubr (&Sunlock_file); defsubr (&Slock_buffer); + defsubr (&Sunlock_buffer); defsubr (&Sfile_locked_p); } diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index ca1163bb77..aac1b13bd0 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -856,7 +856,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (tramp-archive-cleanup-hash)))) ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-archive-test39-make-nearby-temp-file () +(ert-deftest tramp-archive-test40-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless tramp-archive-enabled) ;; Since Emacs 26.1. @@ -893,7 +893,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (delete-directory tmp-file) (should-not (file-exists-p tmp-file)))) -(ert-deftest tramp-archive-test42-file-system-info () +(ert-deftest tramp-archive-test43-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless tramp-archive-enabled) ;; Since Emacs 27.1. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7f894448a6..0e70f8e1d2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -33,7 +33,7 @@ ;; remote host, set this environment variable to "/dev/null" or ;; whatever is appropriate on your system. -;; For slow remote connections, `tramp-test43-asynchronous-requests' +;; For slow remote connections, `tramp-test44-asynchronous-requests' ;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper ;; value less than 10 could help. @@ -122,6 +122,7 @@ (setq auth-source-save-behavior nil password-cache-expiry nil remote-file-name-inhibit-cache nil + create-lockfiles nil tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil tramp-persistency-file-name nil @@ -2463,6 +2464,8 @@ This checks also `file-name-as-directory', `file-name-directory', "^\\'") tramp--test-messages)))))))) + ;; We do not test lockname here. See `tramp-test39-lock-file'. + ;; Do not overwrite if excluded. (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always) ;; Ange-FTP. @@ -2833,8 +2836,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (delete-directory tmp-name1 nil 'trash) ;; tramp-rclone.el and tramp-sshfs.el call the local ;; `delete-directory'. This raises another error. - :type (if (or (tramp--test-rclone-p) (tramp--test-sshfs-p)) - 'error 'file-error)) + :type (if (tramp--test-fuse-p) 'error 'file-error)) (delete-directory tmp-name1 'recursive 'trash) (should-not (file-directory-p tmp-name1)) (should @@ -5741,8 +5743,77 @@ Use direct async.") (ignore-errors (delete-file tmp-name1)) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) +;; The functions were introduced in Emacs 28.1. +(ert-deftest tramp-test39-lock-file () + "Check `lock-file', `unlock-file' and `file-locked-p'." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-ange-ftp-p))) + ;; Since Emacs 28.1. + (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file))) + + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted)) + (remote-file-name-inhibit-cache t) + (create-lockfiles t) + (inhibit-message t) + ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files. + (tramp-cleanup-connection-hook + (append + (and (tramp--test-fuse-p) '(tramp-fuse-unmount)) + tramp-cleanup-connection-hook)) + noninteractive) + + (unwind-protect + (progn + ;; A simple file lock. + (should-not (file-locked-p tmp-name)) + (lock-file tmp-name) + (should (eq (file-locked-p tmp-name) t)) + + ;; If it is locked already, nothing changes. + (lock-file tmp-name) + (should (eq (file-locked-p tmp-name) t)) + + ;; A new connection changes process id, and also the + ;; lockname contents. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (should (stringp (file-locked-p tmp-name))) + + ;; Steal the file lock. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s))) + (lock-file tmp-name)) + (should (eq (file-locked-p tmp-name) t)) + + ;; Ignore the file lock. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p))) + (lock-file tmp-name)) + (should (stringp (file-locked-p tmp-name))) + + ;; Quit the file lock machinery. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) + (should-error (lock-file tmp-name) :type 'file-locked)) + (should (stringp (file-locked-p tmp-name))) + + ;; The same for `write-region'. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) + (should-error (write-region "foo" nil tmp-name) :type 'file-locked) + (should-error + (write-region "foo" nil tmp-name nil nil tmp-name) + :type 'file-locked)) + (should (stringp (file-locked-p tmp-name))) + (should-not (file-exists-p tmp-name))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)) + (unlock-file tmp-name) + (should-not (file-locked-p tmp-name)))))) + ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-test39-make-nearby-temp-file () +(ert-deftest tramp-test40-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-ange-ftp-p))) @@ -5825,6 +5896,10 @@ This does not support globbing characters in file names (yet)." (string-match-p "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))) +(defun tramp--test-fuse-p () + "Check, whether an FUSE file system isused." + (or (tramp--test-rclone-p) (tramp--test-sshfs-p))) + (defun tramp--test-gdrive-p () "Check, whether the gdrive method is used." (string-equal @@ -6115,7 +6190,7 @@ This requires restrictions of file name syntax." (ignore-errors (delete-directory tmp-name2 'recursive)))))) (defun tramp--test-special-characters () - "Perform the test in `tramp-test40-special-characters*'." + "Perform the test in `tramp-test41-special-characters*'." ;; Newlines, slashes and backslashes in file names are not ;; supported. So we don't test. And we don't test the tab ;; character on Windows or Cygwin, because the backslash is @@ -6173,7 +6248,7 @@ This requires restrictions of file name syntax." files (list (mapconcat #'identity files "")))))) ;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test40-special-characters () +(ert-deftest tramp-test41-special-characters () "Check special characters in file names." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) @@ -6181,7 +6256,7 @@ This requires restrictions of file name syntax." (tramp--test-special-characters)) -(ert-deftest tramp-test40-special-characters-with-stat () +(ert-deftest tramp-test41-special-characters-with-stat () "Check special characters in file names. Use the `stat' command." :tags '(:expensive-test) @@ -6199,7 +6274,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test40-special-characters-with-perl () +(ert-deftest tramp-test41-special-characters-with-perl () "Check special characters in file names. Use the `perl' command." :tags '(:expensive-test) @@ -6220,7 +6295,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test40-special-characters-with-ls () +(ert-deftest tramp-test41-special-characters-with-ls () "Check special characters in file names. Use the `ls' command." :tags '(:expensive-test) @@ -6241,7 +6316,7 @@ Use the `ls' command." (tramp--test-special-characters))) (defun tramp--test-utf8 () - "Perform the test in `tramp-test41-utf8*'." + "Perform the test in `tramp-test42-utf8*'." (let* ((utf8 (if (and (eq system-type 'darwin) (memq 'utf-8-hfs (coding-system-list))) 'utf-8-hfs 'utf-8)) @@ -6287,7 +6362,7 @@ Use the `ls' command." (replace-regexp-in-string "[ \t\n/.?]" "" x))) language-info-alist))))))) -(ert-deftest tramp-test41-utf8 () +(ert-deftest tramp-test42-utf8 () "Check UTF8 encoding in file names and file contents." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-docker-p))) @@ -6300,7 +6375,7 @@ Use the `ls' command." (tramp--test-utf8)) -(ert-deftest tramp-test41-utf8-with-stat () +(ert-deftest tramp-test42-utf8-with-stat () "Check UTF8 encoding in file names and file contents. Use the `stat' command." :tags '(:expensive-test) @@ -6322,7 +6397,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test41-utf8-with-perl () +(ert-deftest tramp-test42-utf8-with-perl () "Check UTF8 encoding in file names and file contents. Use the `perl' command." :tags '(:expensive-test) @@ -6347,7 +6422,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test41-utf8-with-ls () +(ert-deftest tramp-test42-utf8-with-ls () "Check UTF8 encoding in file names and file contents. Use the `ls' command." :tags '(:expensive-test) @@ -6371,7 +6446,7 @@ Use the `ls' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test42-file-system-info () +(ert-deftest tramp-test43-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless (tramp--test-enabled)) ;; Since Emacs 27.1. @@ -6388,11 +6463,11 @@ Use the `ls' command." (numberp (nth 1 fsi)) (numberp (nth 2 fsi)))))) -;; `tramp-test43-asynchronous-requests' could be blocked. So we set a +;; `tramp-test44-asynchronous-requests' could be blocked. So we set a ;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300 ;; seconds. Similar check is performed in the timer function. (defconst tramp--test-asynchronous-requests-timeout 300 - "Timeout for `tramp-test43-asynchronous-requests'.") + "Timeout for `tramp-test44-asynchronous-requests'.") (defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body) "Set \"process-name\" and \"process-buffer\" connection properties. @@ -6428,7 +6503,7 @@ This is needed in timer functions as well as process filters and sentinels." (tramp-flush-connection-property v "process-buffer"))))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test43-asynchronous-requests () +(ert-deftest tramp-test44-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -6628,11 +6703,11 @@ process sentinels. They shall not disturb each other." (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive)))))) -;; (tramp--test--deftest-direct-async-process tramp-test43-asynchronous-requests +;; (tramp--test--deftest-direct-async-process tramp-test44-asynchronous-requests ;; "Check parallel direct asynchronous requests." 'unstable) ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test44-auto-load () +(ert-deftest tramp-test45-auto-load () "Check that Tramp autoloads properly." ;; If we use another syntax but `default', Tramp is already loaded ;; due to the `tramp-change-syntax' call. @@ -6657,7 +6732,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test44-delay-load () +(ert-deftest tramp-test45-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; The autoloaded Tramp objects are different since Emacs 26.1. We ;; cannot test older Emacsen, therefore. @@ -6690,7 +6765,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test44-recursive-load () +(ert-deftest tramp-test45-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -6714,7 +6789,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test44-remote-load-path () +(ert-deftest tramp-test45-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; The autoloaded Tramp objects are different since Emacs 26.1. We ;; cannot test older Emacsen, therefore. @@ -6743,7 +6818,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test45-unload () +(ert-deftest tramp-test46-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -6826,7 +6901,7 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Implement `tramp-test31-interrupt-process' for `adb', `sshfs' and ;; for direct async processes. ;; * Check, why direct async processes do not work for -;; `tramp-test43-asynchronous-requests'. +;; `tramp-test44-asynchronous-requests'. (provide 'tramp-tests) commit 90c89e8bdeca61aceae79e4c60a9a51800574914 Merge: e7cdbc1d1d fbf1cb2bf2 Author: Glenn Morris Date: Wed Jul 7 08:04:03 2021 -0700 Merge from origin/emacs-27 fbf1cb2bf2 (origin/emacs-27) Fix overfull hbox in Emacs manual fda60094a2 Minor copyedits of Emacs manual # Conflicts: # doc/emacs/display.texi commit e7cdbc1d1d46b365ec3a7f5eaa0c14f60119014e Author: Lars Ingebrigtsen Date: Tue Jul 6 22:01:55 2021 +0200 Make previous empty-body warning disabling more robust * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): `byte-compile-warning-enabled-p' may not be defined here. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 11387df214..f4bab9c345 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -318,18 +318,20 @@ Assumes the caller has bound `macroexpand-all-environment'." (`(,(or 'function 'quote) . ,_) form) (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) pcase--dontcare)) - (macroexp--cons fun - (macroexp--cons - (macroexp--all-clauses bindings 1) - (if (null body) - (macroexp-unprogn - (macroexp-warn-and-return - (and (byte-compile-warning-enabled-p t) - (format "Empty %s body" fun)) - nil t)) - (macroexp--all-forms body)) - (cdr form)) - form)) + (macroexp--cons + fun + (macroexp--cons + (macroexp--all-clauses bindings 1) + (if (null body) + (macroexp-unprogn + (macroexp-warn-and-return + (and (or (not (fboundp 'byte-compile-warning-enabled-p)) + (byte-compile-warning-enabled-p t)) + (format "Empty %s body" fun)) + nil t)) + (macroexp--all-forms body)) + (cdr form)) + form)) (`(,(and fun `(lambda . ,_)) . ,args) ;; Embedded lambda in function position. ;; If the byte-optimizer is loaded, try to unfold this, commit 044742bfe8c7c22e303242c40e16fbe9e564727a Author: Basil L. Contovounesios Date: Tue Jul 6 01:05:41 2021 +0100 Avoid invalid regexp in wide docstring check * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p): Avoid constructing an invalid regexp during byte-compilation by limiting the number of columns to the current RE_DUP_MAX of 65535. This protects against pathological values of fill-column, for example (bug#49426). diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 70999648d4..6970c8a505 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1627,7 +1627,7 @@ the `\\\\=[command]' ones that are assumed to be of length `byte-compile--wide-docstring-substitution-len'. Also ignore URLs." (string-match - (format "^.\\{%s,\\}$" (int-to-string (1+ col))) + (format "^.\\{%d,\\}$" (min (1+ col) #xffff)) ; Heed RE_DUP_MAX. (replace-regexp-in-string (rx (or ;; Ignore some URLs. commit 4db28a9dc83be033d309782e5b14c9ebc9f01f38 Author: Juri Linkov Date: Tue Jul 6 20:53:09 2021 +0300 * lisp/repeat.el (describe-repeat-maps): Rename from `describe-repeat'. Fix text strings (bug#49265). diff --git a/lisp/repeat.el b/lisp/repeat.el index 503cb34000..cec3cb643a 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -397,7 +397,7 @@ When Repeat mode is enabled, and the command symbol has the property named (and (commandp s) (get s 'repeat-map) (push (get s 'repeat-map) keymaps)))))) - (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat'." + (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'." (length commands) (length (delete-dups keymaps)))))) @@ -489,10 +489,10 @@ When Repeat mode is enabled, and the command symbol has the property named repeat-echo-mode-line-string))) (force-mode-line-update t))) -(defun describe-repeat () - "Describe repeatable commands and keymaps." +(defun describe-repeat-maps () + "Describe mappings of commands repeatable by symbol property `repeat-map'." (interactive) - (help-setup-xref (list #'describe-repeat) + (help-setup-xref (list #'describe-repeat-maps) (called-interactively-p 'interactive)) (let ((keymaps nil)) (all-completions @@ -502,7 +502,7 @@ When Repeat mode is enabled, and the command symbol has the property named (push s (alist-get (get s 'repeat-map) keymaps))))) (with-help-window (help-buffer) (with-current-buffer standard-output - (princ "This is a list of repeatable keymaps and commands.\n\n") + (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n") (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b))))) (princ (format-message "`%s' keymap is repeatable by these commands:\n" commit 855fd921201a75a21ff225128a8dced16cd95b52 Author: Lars Ingebrigtsen Date: Tue Jul 6 19:25:41 2021 +0200 Make `M-x clipboard-yank' work reliably * lisp/menu-bar.el (clipboard-yank): Make the command work consistently (bug#27442). * lisp/select.el (gui-selection-value): Try to explain why the logic is the way it is. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 739e751d8a..8def1575b2 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -570,7 +570,9 @@ (defun clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((select-enable-clipboard t)) + (let ((select-enable-clipboard t) + ;; Ensure that we defeat the DWIM login in `gui-selection-value'. + (gui--last-selected-text-clipboard nil)) (yank))) (defun clipboard-kill-ring-save (beg end &optional region) diff --git a/lisp/select.el b/lisp/select.el index c39bc93dea..eaa74cebd8 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -184,11 +184,17 @@ decoded. If `gui-get-selection' signals an error, return nil." (let ((clip-text (when select-enable-clipboard (let ((text (gui--selection-value-internal 'CLIPBOARD))) - (if (string= text "") (setq text nil)) - - ;; Check the CLIPBOARD selection for 'newness', is it different - ;; from what we remembered them to be last time we did a - ;; cut/paste operation. + (when (string= text "") + (setq text nil)) + ;; When `select-enable-clipboard' is non-nil, + ;; killing/copying text (with, say, `C-w') will push the + ;; text to the clipboard (and store it in + ;; `gui--last-selected-text-clipboard'). We check + ;; whether the text on the clipboard is identical to this + ;; text, and if so, we report that the clipboard is + ;; empty. See (bug#27442) for further discussion about + ;; this DWIM action, and possible ways to make this check + ;; less fragile, if so desired. (prog1 (unless (equal text gui--last-selected-text-clipboard) text) commit abe5eb9adda956ccc72af02d714025701e528b55 Author: Lars Ingebrigtsen Date: Tue Jul 6 19:13:45 2021 +0200 Explain what ( . c) means to the Emacs Lisp reader * doc/lispref/objects.texi (Dotted Pair Notation): Explain what ( . c) means to the Lisp reader (bug#24875). diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index d8091f1b4b..365d5ac8d6 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1001,6 +1001,13 @@ It looks like this: @end example @end ifnottex + As a somewhat peculiar side effect of @code{(a b . c)} and +@code{(a . (b . c))} being equivalent, for consistency this means +that if you replace @code{b} here with the empty sequence, then it +follows that @code{(a . c)} and @code{(a . ( . c))} are equivalent, +too. This also means that @code{( . c)} is equivalent to @code{c}, +but this is seldom used. + @node Association List Type @subsubsection Association List Type commit 10753bc6888c997c31408a3ec59df42a4bef0005 Author: Eli Zaretskii Date: Tue Jul 6 20:11:51 2021 +0300 Fix right-margin display on TTY frames * src/dispnew.c (prepare_desired_row, adjust_glyph_matrix): Adjust the glyph pointer of the right-margin area for all windows but the rightmost ones on TTY frames, to account for the border glyph. (Bug#48257) diff --git a/src/dispnew.c b/src/dispnew.c index 1378c34e98..0c31319917 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -473,6 +473,10 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y = row->glyphs[LEFT_MARGIN_AREA] + left; row->glyphs[RIGHT_MARGIN_AREA] = row->glyphs[TEXT_AREA] + dim.width - left - right; + /* Leave room for a border glyph. */ + if (!FRAME_WINDOW_P (XFRAME (w->frame)) + && !WINDOW_RIGHTMOST_P (w)) + row->glyphs[RIGHT_MARGIN_AREA] -= 1; row->glyphs[LAST_AREA] = row->glyphs[LEFT_MARGIN_AREA] + dim.width; } @@ -1140,7 +1144,13 @@ prepare_desired_row (struct window *w, struct glyph_row *row, bool mode_line_p) row->glyphs[TEXT_AREA] = row->glyphs[LEFT_MARGIN_AREA] + left; if (w->right_margin_cols > 0 && (right != row->glyphs[LAST_AREA] - row->glyphs[RIGHT_MARGIN_AREA])) - row->glyphs[RIGHT_MARGIN_AREA] = row->glyphs[LAST_AREA] - right; + { + row->glyphs[RIGHT_MARGIN_AREA] = row->glyphs[LAST_AREA] - right; + /* Leave room for a border glyph. */ + if (!FRAME_WINDOW_P (XFRAME (w->frame)) + && !WINDOW_RIGHTMOST_P (w)) + row->glyphs[RIGHT_MARGIN_AREA] -= 1; + } } } commit 69f1bd38f0628503dac935b2b38dca430d80266b Author: Lars Ingebrigtsen Date: Tue Jul 6 18:56:51 2021 +0200 Warn when wrapping index matches with `,' after `i' in Info * lisp/info.el (Info--current-index-alternative): New internal variable. (Info-warn-on-index-alternatives-wrap): New user option (bug#24282). (Info-index-next): Use the new user option. diff --git a/etc/NEWS b/etc/NEWS index b1ab6941d0..7bf8c1d8f5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1185,6 +1185,16 @@ can provide a better overview in a long list of available bindings. In previous Emacs versions, the "*Help*" buffer was killed instead when clicking the "X" icon in the tool bar. +** Info + +--- +*** New user option 'Info-warn-on-index-alternatives-wrap'. +This option affects what happens when using the ',' command after +looking up an entry with 'i' in info buffers. If non-nil (the +default), the ',' command will now warn you when proceeding beyond the +final entry, and tapping ',' once more will then take you to the +first entry. + +++ ** New command 'lossage-size'. It allows users to set the maximum number of keystrokes and commands diff --git a/lisp/info.el b/lisp/info.el index cdf339ff6f..b65728ba41 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -391,6 +391,14 @@ where SUPPORTS-INDEX-COOKIES can be either t or nil.") (defvar-local Info-index-alternatives nil "List of possible matches for last `Info-index' command.") +(defvar-local Info--current-index-alternative 0 + "Current displayed index alternative.") + +(defcustom Info-warn-on-index-alternatives-wrap t + "Warn when wrapping to the beginning/end when displaying index alternatives." + :type 'boolean + :version "28.1") + (defvar Info-point-loc nil "Point location within a selected node. If string, the point is moved to the proper occurrence of the @@ -3375,39 +3383,56 @@ Give an empty topic name to go to the Index node itself." (setq exact (cons found exact) matches (delq found matches))) (setq Info-history-list ohist-list) - (setq Info-index-alternatives (nconc exact (nreverse matches))) + (setq Info-index-alternatives (nconc exact (nreverse matches)) + Info--current-index-alternative 0) (Info-index-next 0))))) (defun Info-index-next (num) - "Go to the next matching index item from the last \\\\[Info-index] command." + "Go to the next matching index item from the last \\\\[Info-index] command. +If given a numeric prefix, skip that many index items forward (or +backward). + +Also see the `Info-warn-on-index-alternatives-wrap' user option." (interactive "p" Info-mode) - (or Info-index-alternatives - (user-error "No previous `i' command")) - (while (< num 0) - (setq num (+ num (length Info-index-alternatives)))) - (while (> num 0) - (setq Info-index-alternatives - (nconc (cdr Info-index-alternatives) - (list (car Info-index-alternatives))) - num (1- num))) - (Info-goto-node (nth 1 (car Info-index-alternatives))) - (if (> (nth 3 (car Info-index-alternatives)) 0) - ;; Forward 2 lines less because `Info-find-node-2' initially - ;; puts point to the 2nd line. - (forward-line (- (nth 3 (car Info-index-alternatives)) 2)) - (forward-line 3) ; don't search in headers - (let ((name (car (car Info-index-alternatives)))) - (Info-find-index-name name))) - (message "Found `%s' in %s. %s" - (car (car Info-index-alternatives)) - (nth 2 (car Info-index-alternatives)) - (if (cdr Info-index-alternatives) - (format-message - "(%s total; use `%s' for next)" - (length Info-index-alternatives) - (key-description (where-is-internal - 'Info-index-next overriding-local-map t))) - "(Only match)"))) + (unless Info-index-alternatives + (user-error "No previous `i' command")) + (let ((index (+ Info--current-index-alternative num)) + (total (length Info-index-alternatives)) + (next-key (key-description (where-is-internal + 'Info-index-next overriding-local-map t)))) + (if (and Info-warn-on-index-alternatives-wrap + (> total 1) + (cond + ((< index 0) + (setq Info--current-index-alternative (- total 2)) + (message + "No previous matches, use `%s' to continue from end of list" + next-key) + t) + ((>= index total) + (setq Info--current-index-alternative -1) + (message + "No previous matches, use `%s' to continue from start of list" + next-key) + t))) + () ; Do nothing + (setq index (mod index total) + Info--current-index-alternative index) + (let ((entry (nth index Info-index-alternatives))) + (Info-goto-node (nth 1 entry)) + (if (> (nth 3 entry) 0) + ;; Forward 2 lines less because `Info-find-node-2' initially + ;; puts point to the 2nd line. + (forward-line (- (nth 3 entry) 2)) + (forward-line 3) ; don't search in headers + (Info-find-index-name (car entry))) + (message "Found `%s' in %s. %s" + (car entry) + (nth 2 entry) + (if (> total 1) + (format-message + "(%s total; use `%s' for next)" total next-key) + "(Only match)")))))) (defun Info-find-index-name (name) "Move point to the place within the current node where NAME is defined." commit 1431fd91b4d885560800e6b1b2a47aac24f72ff1 Author: Protesilaos Stavrou Date: Tue Jul 6 10:44:46 2021 +0300 Add faces for shr heading elements (bug#49433) * etc/NEWS: Document new faces. * lisp/net/shr.el (shr-h1, shr-h2, shr-h3, shr-h4, shr-h5, shr-h6): Define new faces. (shr-tag-h1): Remove inclusion of 'variable-pitch' face. Fix bug#49433 by applying a new face directly. (shr-tag-h2, shr-tag-h3, shr-tag-h4, shr-tag-h5, shr-tag-h6): Apply new faces. diff --git a/etc/NEWS b/etc/NEWS index c3eaf5fcbb..b1ab6941d0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1620,6 +1620,10 @@ t, which preserves the original behavior. If set non-nil, showing an unseen message will set the Rmail buffer's modified flag. +--- +*** New faces for heading elements. +Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'. + ** Apropos *** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 873f0457e3..85d81b6bbc 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -183,6 +183,33 @@ temporarily blinks with this face." "Face for elements." :version "27.1") +(defface shr-h1 + '((t :height 1.3 :weight bold)) + "Face for

elements." + :version "28.1") + +(defface shr-h2 + '((t :weight bold)) + "Face for

elements." + :version "28.1") + +(defface shr-h3 + '((t :slant italic)) + "Face for

elements." + :version "28.1") + +(defface shr-h4 nil + "Face for

elements." + :version "28.1") + +(defface shr-h5 nil + "Face for

elements." + :version "28.1") + +(defface shr-h6 nil + "Face for
elements." + :version "28.1") + (defcustom shr-inhibit-images nil "If non-nil, inhibit loading images." :version "28.1" @@ -1939,24 +1966,22 @@ BASE is the URL of the HTML being rendered." (shr-generic dom)) (defun shr-tag-h1 (dom) - (shr-heading dom (if shr-use-fonts - '(variable-pitch (:height 1.3 :weight bold)) - 'bold))) + (shr-heading dom 'shr-h1)) (defun shr-tag-h2 (dom) - (shr-heading dom 'bold)) + (shr-heading dom 'shr-h2)) (defun shr-tag-h3 (dom) - (shr-heading dom 'italic)) + (shr-heading dom 'shr-h3)) (defun shr-tag-h4 (dom) - (shr-heading dom)) + (shr-heading dom 'shr-h4)) (defun shr-tag-h5 (dom) - (shr-heading dom)) + (shr-heading dom 'shr-h5)) (defun shr-tag-h6 (dom) - (shr-heading dom)) + (shr-heading dom 'shr-h6)) (defun shr-tag-hr (_dom) (shr-ensure-newline) commit d8bd7d015e626c73351938626a01288028ebe1c5 Author: Lars Ingebrigtsen Date: Tue Jul 6 17:04:28 2021 +0200 Make gnus-gcc-externalize-attachments work again * lisp/gnus/gnus-msg.el (gnus-inews-do-gcc): Allow externalizing parts again by defeating the cache (bug#49436). diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index bac987e2f0..db54237a76 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1597,6 +1597,10 @@ this is a reply." (if (stringp gnus-gcc-externalize-attachments) (string-match gnus-gcc-externalize-attachments group) gnus-gcc-externalize-attachments)) + ;; If we want to externalize stuff when GCC-ing, then we + ;; can't use the cache, because that has all the contents. + (when mml-externalize-attachments + (setq encoded-cache nil)) (save-excursion (nnheader-set-temp-buffer " *acc*") (setq message-options (with-current-buffer cur message-options)) commit 43fba076c99cb8e62236f636bfc036068a63c166 Author: Lars Ingebrigtsen Date: Tue Jul 6 16:43:49 2021 +0200 Allow inhibiting warnings about unused variables and empty bodies * lisp/emacs-lisp/cconv.el (cconv--warn-unused-msg): Allow inhibiting warnings about unbound variables (bug#26486). * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Allow inhibiting warnings about empty bodies. diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index f663710902..f1579cda8b 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -259,7 +259,8 @@ Returns a form where all lambdas don't have any free variables." (not (intern-soft var)) (eq ?_ (aref (symbol-name var) 0)) ;; As a special exception, ignore "ignore". - (eq var 'ignored)) + (eq var 'ignored) + (not (byte-compile-warning-enabled-p 'unbound var))) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) (format "Unused lexical %s `%S'%s" varkind var diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index df864464b7..11387df214 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -319,14 +319,16 @@ Assumes the caller has bound `macroexpand-all-environment'." (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) pcase--dontcare)) (macroexp--cons fun - (macroexp--cons (macroexp--all-clauses bindings 1) - (if (null body) - (macroexp-unprogn - (macroexp-warn-and-return - (format "Empty %s body" fun) - nil t)) - (macroexp--all-forms body)) - (cdr form)) + (macroexp--cons + (macroexp--all-clauses bindings 1) + (if (null body) + (macroexp-unprogn + (macroexp-warn-and-return + (and (byte-compile-warning-enabled-p t) + (format "Empty %s body" fun)) + nil t)) + (macroexp--all-forms body)) + (cdr form)) form)) (`(,(and fun `(lambda . ,_)) . ,args) ;; Embedded lambda in function position. commit 748bf7b93edcfd1707fa3f593a330979e280eb49 Author: Lars Ingebrigtsen Date: Tue Jul 6 16:33:25 2021 +0200 Allow using `mm-inline-message' from other mail clients than Gnus * lisp/gnus/mm-view.el (mm-inline-message-prepare-function): New variable (bug#49380). (mm-inline-message): Use it to separate out the Gnus-specific code. * lisp/gnus/gnus-art.el (gnus-mime-display-single): ... which has been moved here. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index f2ec9462c5..b989446792 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6039,7 +6039,28 @@ If nil, don't show those extra buttons." (ignored gnus-ignored-mime-types) (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight)) (not-attachment t) - display text) + ;; Arrange a callback from `mm-inline-message' if we're + ;; displaying a message/rfc822 part. + (mm-inline-message-prepare-function + (lambda (charset) + (let ((handles + (let (gnus-article-mime-handles + ;; disable prepare hook + gnus-article-prepare-hook + (gnus-newsgroup-charset + ;; mm-uu might set it. + (unless (eq charset 'gnus-decoded) + (or charset gnus-newsgroup-charset)))) + (let ((gnus-original-article-buffer + (mm-handle-buffer handle))) + (run-hooks 'gnus-article-decode-hook)) + (gnus-article-prepare-display) + gnus-article-mime-handles))) + (when handles + (setq gnus-article-mime-handles + (mm-merge-handles gnus-article-mime-handles handles)))))) + display text + gnus-displaying-mime) (catch 'ignored (progn (while ignored diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 3e36d6724e..2ec75a0bc5 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -418,16 +418,18 @@ This is only used if `mm-inline-large-images' is set to (fundamental-mode) (goto-char (point-min))) -(defvar gnus-original-article-buffer) -(defvar gnus-article-prepare-hook) -(defvar gnus-displaying-mime) +(defvar mm-inline-message-prepare-function nil + "Function called by `mm-inline-message' to do client specific setup. +It is called with one parameter -- the charset.") (defun mm-inline-message (handle) + "Insert HANDLE (a message/rfc822 part) into the current buffer. +This function will call `mm-inline-message-prepare-function' +after inserting the part." (let ((b (point)) (bolp (bolp)) (charset (mail-content-type-get - (mm-handle-type handle) 'charset)) - gnus-displaying-mime handles) + (mm-handle-type handle) 'charset))) (when (and charset (stringp charset)) (setq charset (intern (downcase charset))) @@ -437,16 +439,8 @@ This is only used if `mm-inline-large-images' is set to (save-restriction (narrow-to-region b b) (mm-insert-part handle) - (let (gnus-article-mime-handles - ;; disable prepare hook - gnus-article-prepare-hook - (gnus-newsgroup-charset - (unless (eq charset 'gnus-decoded) ;; mm-uu might set it. - (or charset gnus-newsgroup-charset)))) - (let ((gnus-original-article-buffer (mm-handle-buffer handle))) - (run-hooks 'gnus-article-decode-hook)) - (gnus-article-prepare-display) - (setq handles gnus-article-mime-handles)) + (when mm-inline-message-prepare-function + (funcall mm-inline-message-prepare-function charset)) (goto-char (point-min)) (unless bolp (insert "\n")) @@ -454,9 +448,6 @@ This is only used if `mm-inline-large-images' is set to (unless (bolp) (insert "\n")) (insert "----------\n\n") - (when handles - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles))) (mm-handle-set-undisplayer handle (let ((beg (point-min-marker)) commit fbf1cb2bf2de54bf894b45225d5ef6bf93f5f70b Author: Eli Zaretskii Date: Tue Jul 6 15:25:51 2021 +0300 Fix overfull hbox in Emacs manual * doc/emacs/display.texi (Displaying Boundaries): Fix overfull hbox. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 69d5df1b01..dfd3a5a43d 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1181,8 +1181,8 @@ that has some special meaning for formatting the source code of a program. To activate the fill-column indication display, use the minor modes -@w{@kbd{M-x display-fill-column-indicator-mode}} and -@w{@kbd{M-x global-display-fill-column-indicator-mode}}, which enable +@code{display-fill-column-indicator-mode} and +@code{global-display-fill-column-indicator-mode}, which enable the indicator locally or globally, respectively. Alternatively, you can set the two buffer-local variables commit fda60094a2a686323bcf23439e286f2240cfe737 Author: Eli Zaretskii Date: Tue Jul 6 14:57:19 2021 +0300 Minor copyedits of Emacs manual * doc/emacs/book-spine.texi: Fix the author attribution. (Bug#49405) * doc/emacs/back.texi: Update text. diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi index e1a2a04ecb..549e0e925e 100644 --- a/doc/emacs/back.texi +++ b/doc/emacs/back.texi @@ -15,21 +15,18 @@ @sp 1 @quotation -GNU Emacs is much more than a text editor; over the years, it has -expanded to become an entire workflow environment, impressing -programmers with its integrated debugging and project-management -features. It is also a multi-lingual word processor, can handle all -your email and Usenet news needs, display web pages, and even has a -diary and a calendar for your appointments! +GNU Emacs is much @strong{more than a text editor}; over the years, it +has expanded to become @strong{an entire workflow environment}, +impressing programmers with its integrated debugging and +project-management features. It is also a multi-lingual word +processor, can handle all your email and Usenet news needs, display +web pages, and even has a diary and a calendar for your appointments! -And when you tire of all the work you can accomplish with it, Emacs -contains games to play. - -@strong{Features include:} +Features include: @itemize @bullet @item -Special editing modes for @strong{27 programing languages}, including C, +Special editing modes for @strong{27 programming languages}, including C, C@t{++}, Fortran, Java, JavaScript, Lisp, Objective C, Pascal, Perl, and Scheme. @@ -48,8 +45,8 @@ The ability to: @itemize @minus @item -Create @strong{PostScript output} from plain-text files (special editing -modes for @LaTeX{} and @TeX{} are included). +Create @strong{PostScript output} from plain-text files (special +editing modes for @LaTeX{} and @TeX{} are included). @item @strong{Compile} and @strong{debug} from inside Emacs. @@ -59,7 +56,7 @@ Maintain program @strong{ChangeLogs}. @item Flag, move, and delete files and sub-directories recursively -(@strong{directory navigation}). +@strong{(directory navigation).} @item Run @strong{shell commands} from inside Emacs, or even use Emacs itself @@ -69,23 +66,28 @@ as a shell (Eshell). Enjoy the use of extensive @strong{merge} and @strong{diff} functions. @item -Take advantage of built-in support for many @strong{version control} -systems, including Git, Mercurial, Bazaar, Subversion, and CVS. +Take advantage of built-in support for many @strong{version control +systems}, including Git, Mercurial, Bazaar, Subversion, and CVS. @item And much more! @end itemize @end itemize +And when you tire of all the work you can accomplish with it, Emacs +contains games to play. + Emacs comes with an introductory online tutorial available in many -languages. This book picks up where that tutorial ends. It explains -the full range of Emacs's power and contains reference material useful -to expert users. +languages, and this manual picks up where that tutorial ends. It +explains the full range of the power of Emacs, now up to @strong{version +27.2}, and contains reference material useful to expert users. It +also includes appendices with specific material about X and GTK +resources, and with details for users of macOS and Microsoft Windows. Appendices are included, with specific material about X and GTK resources, and with details for users of Macintosh and Microsoft OS. -@strong{About the Author:} +@strong{About the original and principal Author:} Richard M.@: Stallman developed the first Emacs in 1975 and wrote GNU Emacs in 1984/85. He has received the ACM Grace Hopper Award, a diff --git a/doc/emacs/book-spine.texi b/doc/emacs/book-spine.texi index 84a0168c05..17fccee135 100644 --- a/doc/emacs/book-spine.texi +++ b/doc/emacs/book-spine.texi @@ -16,5 +16,5 @@ @center @value{EDITION} Edition, for Emacs Version @value{EMACSVER} @sp 5 -@center by Richard M.@: Stallman +@center by Richard M.@: Stallman et al. @bye commit 77631c2a7704f78e6b85846d2c23a2ffc22368cf (refs/remotes/origin/feature/rcirc-update) Author: Philip Kaludercic Date: Tue Jul 6 08:52:50 2021 +0200 Add query command removed in 4ff1f66b12 * rcirc.el (query): Readd accidentally removed command diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index caec150848..af0def8e47 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2480,6 +2480,17 @@ that, an interactive form can specified." (read-string "Message: "))) (rcirc-send-message process chan-or-nick message)) +(rcirc-define-command query (nick) + "Open a private chat buffer to NICK." + (interactive (list (completing-read "Query nick: " + (with-rcirc-server-buffer + rcirc-nick-table)))) + (let ((existing-buffer (rcirc-get-buffer process nick))) + (switch-to-buffer (or existing-buffer + (rcirc-get-buffer-create process nick))) + (when (not existing-buffer) + (rcirc-cmd-whois nick)))) + (rcirc-define-command join (channels) "Join CHANNELS. CHANNELS is a comma- or space-separated string of channel names." commit 1d735756818fcd558722ee1cdc47ad44bcde5fb0 Author: Philip Kaludercic Date: Tue Jul 6 08:50:21 2021 +0200 Fix issues with argument parsing in rcirc-define-command * rcirc.el (rcirc-define-command): Fix issues diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4f8d9612c6..caec150848 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2453,9 +2453,9 @@ that, an interactive form can specified." "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") (interactive (list ,@interactive-spec)) (unless (if (listp ,argument) - (not (<= ,required (length ,argument) ,total)) + (<= ,required (length ,argument) ,total) (string-match ,regexp ,argument)) - (user-error "Malformed input (%s): %S" ,command ',arguments)) + (user-error "Malformed input (%s): %S" ',command ',argument)) (let ((process (or process (rcirc-buffer-process))) (target (or target rcirc-target))) (ignore target process) commit 6ec3cf1ccb5380acc376e89140b8d3a7fa4e471a Author: Dmitry Gutov Date: Tue Jul 6 01:55:26 2021 +0300 (xref--insert-xrefs): Fix printing of line numbers * lisp/progmodes/xref.el (xref--insert-xrefs): Fix printing of line numbers when we have multiple files with (e.g.) single match on the same line. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b7a926f82e..e2cd904a6c 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -959,7 +959,9 @@ GROUP is a string for decoration purposes and XREF is an (prefix (cond ((not line) " ") - ((equal line prev-line) "") + ((and (equal line prev-line) + (equal prev-group group)) + "") (t (propertize (format line-format line) 'face 'xref-line-number))))) ;; Render multiple matches on the same line, together. commit f2896fdb6ab827193166a26839f710a197a6ba57 Author: Philipp Stephani Date: Mon Jul 5 20:34:36 2021 +0200 ; * test/lisp/subr-tests.el (subr-tests-add-hook-depth): Fix a typo. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 375251cffc..b57982a705 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -477,7 +477,7 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (add-hook 'subr-tests--hook 'f7 90) (add-hook 'subr-tests--hook 'f8 t) (should (equal subr-tests--hook '(f5 f6 f2 f1 f4 f3 f7 f8))) - ;; Make sue `nil' is equivalent to 0. + ;; Make sure `nil' is equivalent to 0. (add-hook 'subr-tests--hook 'f9 0) (add-hook 'subr-tests--hook 'f10) (should (equal subr-tests--hook '(f5 f10 f9 f6 f2 f1 f4 f3 f7 f8))) commit c03ad2b19eb7d874ad3d46183161e30a8439564c Author: Stephen Leake Date: Mon Jul 5 10:04:56 2021 -0700 * lisp/progmodes/bug-reference.el: Refer to info manual node diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index e502cbb3dc..61d722f5b9 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -25,10 +25,13 @@ ;; This file provides minor modes for putting clickable overlays on ;; references to bugs. A bug reference is text like "PR foo/29292"; -;; this is mapped to a URL using a user-supplied format. +;; this is mapped to a URL using a user-supplied format; see +;; `bug-reference-url-format' and `bug-reference-bug-regexp'. More +;; extensive documentation is in (info "(emacs) Bug Reference"). ;; Two minor modes are provided. One works on any text in the buffer; -;; the other operates only on comments and strings. +;; the other operates only on comments and strings. By default, the +;; URL link is followed by invoking C-c RET or mouse-2. ;;; Code: @@ -126,6 +129,9 @@ The second subexpression should match the bug reference (usually a number)." "Open URL corresponding to the bug reference at POS." (interactive (list (if (integerp last-command-event) (point) last-command-event))) + (when (null bug-reference-url-format) + (user-error + "You must customize some bug-reference variables; see Emacs info node Bug Reference")) (if (and (not (integerp pos)) (eventp pos)) ;; POS is a mouse event; switch to the proper window/buffer (let ((posn (event-start pos))) commit 68276f6d30bbdc09cc26fb49d7f0c3aa4bce35f2 Author: Lars Ingebrigtsen Date: Mon Jul 5 16:56:07 2021 +0200 Support reverting in Customize buffers * lisp/cus-edit.el (custom--revert-buffer): New function (bug#26871). (Custom-mode): Set up reversion. (custom--invocation-options): New variable. (custom-buffer-create-internal): Set it. diff --git a/etc/NEWS b/etc/NEWS index a62e9c86c9..c3eaf5fcbb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1266,6 +1266,9 @@ To revert to the previous behavior, ** Customize +--- +*** Customize buffers can now be reverted with 'C-x x g'. + *** Most customize commands now hide obsolete user options. Obsolete user options are no longer shown in the listings produced by the commands 'customize', 'customize-group', 'customize-apropos' and diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 7627930c4c..a8b2640b7d 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1665,8 +1665,11 @@ Otherwise use brackets." 'custom-button-pressed 'custom-button-pressed-unraised)))) +(defvar custom--invocation-options nil) + (defun custom-buffer-create-internal (options &optional _description) (Custom-mode) + (setq custom--invocation-options options) (let ((init-file (or custom-file user-init-file))) ;; Insert verbose help at the top of the custom buffer. (when custom-buffer-verbose-help @@ -5148,11 +5151,19 @@ if that value is non-nil." :label (nth 5 arg))) custom-commands) (setq custom-tool-bar-map map)))) + (setq-local custom--invocation-options nil) + (setq-local revert-buffer-function #'custom--revert-buffer) (make-local-variable 'custom-options) (make-local-variable 'custom-local-buffer) (custom--initialize-widget-variables) (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)) +(defun custom--revert-buffer (_ignore-auto _noconfirm) + (unless custom--invocation-options + (error "Insufficient data to revert")) + (custom-buffer-create custom--invocation-options + (buffer-name))) + (put 'Custom-mode 'mode-class 'special) (provide 'cus-edit) commit a111978de8fa28256a208d823b68a37188dfa7f0 Author: Lars Ingebrigtsen Date: Mon Jul 5 16:30:43 2021 +0200 Count zero-length matches in `count-matches' correctly * lisp/replace.el (how-many): Count zero-length matches correctly (bug#27359). diff --git a/lisp/replace.el b/lisp/replace.el index fe2cbc447a..ed81097e14 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1089,17 +1089,17 @@ a previously found match." rend (point-max))) (goto-char rstart)) (let ((count 0) - opoint (case-fold-search (if (and case-fold-search search-upper-case) (isearch-no-upper-case-p regexp t) case-fold-search))) (while (and (< (point) rend) - (progn (setq opoint (point)) - (re-search-forward regexp rend t))) - (if (= opoint (point)) - (forward-char 1) - (setq count (1+ count)))) + (re-search-forward regexp rend t)) + ;; Ensure forward progress on zero-length matches like "^$". + (when (and (= (match-beginning 0) (match-end 0)) + (not (eobp))) + (forward-char 1)) + (setq count (1+ count))) (when interactive (message (ngettext "%d occurrence" "%d occurrences" count) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 2db570c97d..6d004e657d 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -601,4 +601,15 @@ bound to HIGHLIGHT-LOCUS." (if (match-string 2) "R" "L"))) (should (equal (buffer-string) after))))) +(ert-deftest test-count-matches () + (with-temp-buffer + (insert "oooooooooo") + (goto-char (point-min)) + (should (= (count-matches "oo") 5)) + (should (= (count-matches "o+") 1))) + (with-temp-buffer + (insert "o\n\n\n\no\n\n") + (goto-char (point-min)) + (should (= (count-matches "^$") 4)))) + ;;; replace-tests.el ends here commit 26b9564bd53685533f71e6e102f5bbf575e0c6af Author: Lars Ingebrigtsen Date: Mon Jul 5 15:55:38 2021 +0200 Propagate :safe properties when autoloading defcustoms * lisp/emacs-lisp/autoload.el (make-autoload): Propagate the :safe property to the loaddefs file (bug#28104). diff --git a/etc/NEWS b/etc/NEWS index 1a3130826a..a62e9c86c9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2914,6 +2914,9 @@ The former is now declared obsolete. * Lisp Changes in Emacs 28.1 +--- +*** :safe settings in 'defcustom' are now propagated to the loaddefs files. + +++ ** New function 'syntax-class-to-char'. This does almost the opposite of 'string-to-syntax' -- it returns the diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index b45984be1d..9d1ae70597 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -250,7 +250,10 @@ expression, in which case we want to handle forms differently." (custom-autoload ',varname ,file ,(condition-case nil (null (plist-get props :set)) - (error nil)))))) + (error nil))) + ;; Propagate the :safe property to the loaddefs file. + ,@(when-let ((safe (plist-get props :safe))) + `((put ',varname 'safe-local-variable ,safe)))))) ((eq car 'defgroup) ;; In Emacs this is normally handled separately by cus-dep.el, but for commit 62fbeed9a91429a852fed882d8bf30bc04377bf0 Author: Lars Ingebrigtsen Date: Mon Jul 5 15:09:45 2021 +0200 Make `bookmark--unfontify' more robust * lisp/bookmark.el (bookmark--unfontify): Don't bug out if there's no fontification recorded (bug#49341). diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 31e41a9273..52b96fd203 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -467,18 +467,18 @@ See user option `bookmark-fontify'." "Remove a bookmark's colorized overlay. BM is a bookmark as returned from function `bookmark-get-bookmark'. See user option `bookmark-fontify'." - (let ((filename (assq 'filename bm)) - (pos (assq 'position bm)) + (let ((filename (cdr (assq 'filename bm))) + (pos (cdr (assq 'position bm))) overlays found temp) - (when filename (setq filename (expand-file-name (cdr filename)))) - (when pos (setq pos (cdr pos))) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (equal filename buffer-file-name) - (setq overlays (overlays-at pos)) - (while (and (not found) (setq temp (pop overlays))) - (when (eq 'bookmark (overlay-get temp 'category)) - (delete-overlay (setq found temp))))))))) + (when (and pos filename) + (setq filename (expand-file-name filename)) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (equal filename buffer-file-name) + (setq overlays (overlays-at pos)) + (while (and (not found) (setq temp (pop overlays))) + (when (eq 'bookmark (overlay-get temp 'category)) + (delete-overlay (setq found temp)))))))))) (defun bookmark-completing-read (prompt &optional default) "Prompting with PROMPT, read a bookmark name in completion. commit 82c6327555252a00404c62302dcc9effbf8fb90a Author: Lars Ingebrigtsen Date: Mon Jul 5 14:49:56 2021 +0200 `image-save' doc string clarification * lisp/image.el (image-save): Clarify what's being saved (bug#49347). diff --git a/lisp/image.el b/lisp/image.el index ee15294031..494c26a8a3 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1191,7 +1191,9 @@ rotations by only multiples of 90 degrees." 360))))) (defun image-save () - "Save the image under point." + "Save the image under point. +This writes the original image data to a file. Rotating or +changing the displayed image size does not affect the saved image." (interactive) (let ((image (image--get-image))) (with-temp-buffer commit 579b0c006e407aef1623f3b42d28b666426406c7 Author: Michael Albinus Date: Mon Jul 5 12:09:28 2021 +0200 Don't use LOCKNAME for temp files in Tramp (Bug#49406) * lisp/net/tramp.el (tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region): Don't use LOCKNAME for temp file. (Bug#49406) * test/lisp/shadowfile-tests.el (password-cache-expiry): Set `shadow-debug' also on emba. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7fb0ff5780..f9569523d9 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -533,7 +533,7 @@ But handle the case, if the \"test\" command is not available." rw-path))))))) (defun tramp-adb-handle-write-region - (start end filename &optional append visit lockname mustbenew) + (start end filename &optional append visit _lockname mustbenew) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil @@ -549,7 +549,7 @@ But handle the case, if the \"test\" command is not available." (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok) (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600))) - (write-region start end tmpfile append 'no-message lockname) + (write-region start end tmpfile append 'no-message) (with-tramp-progress-reporter v 3 (format-message "Moving tmp file `%s' to `%s'" tmpfile filename) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 88caa2fb7b..5f597ff46e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3233,7 +3233,7 @@ implementation will be used." tmpfile))) (defun tramp-sh-handle-write-region - (start end filename &optional append visit lockname mustbenew) + (start end filename &optional append visit _lockname mustbenew) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil @@ -3260,7 +3260,7 @@ implementation will be used." (or (file-directory-p localname) (file-writable-p localname))))) ;; Short track: if we are on the local host, we can run directly. - (write-region start end localname append 'no-message lockname) + (write-region start end localname append 'no-message) (let* ((modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) @@ -3296,7 +3296,7 @@ implementation will be used." (let ((file-coding-system-alist (tramp-find-file-name-coding-system-alist filename tmpfile))) (condition-case err - (write-region start end tmpfile append 'no-message lockname) + (write-region start end tmpfile append 'no-message) ((error quit) (setq tramp-temp-buffer-file-name nil) (delete-file tmpfile) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 6fbf08801e..13edf16756 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1573,7 +1573,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (error filename)))) (defun tramp-smb-handle-write-region - (start end filename &optional append visit lockname mustbenew) + (start end filename &optional append visit _lockname mustbenew) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil @@ -1591,8 +1591,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." ;; We say `no-message' here because we don't want the visited file ;; modtime data to be clobbered from the temp file. We call ;; `set-visited-file-modtime' ourselves later on. - (tramp-run-real-handler - #'write-region (list start end tmpfile append 'no-message lockname)) + (write-region start end tmpfile append 'no-message) (with-tramp-progress-reporter v 3 (format "Moving tmp file %s to %s" tmpfile filename) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index c4a36fe2a3..cac8c40abb 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -279,7 +279,7 @@ arguments to pass to the OPERATION." (tramp-fuse-local-file-name filename) mode flag)))) (defun tramp-sshfs-handle-write-region - (start end filename &optional append visit lockname mustbenew) + (start end filename &optional append visit _lockname mustbenew) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil @@ -291,7 +291,7 @@ arguments to pass to the OPERATION." (tramp-error v 'file-already-exists filename)) (write-region - start end (tramp-fuse-local-file-name filename) append 'nomessage lockname) + start end (tramp-fuse-local-file-name filename) append 'nomessage) (tramp-flush-file-properties v localname) ;; The end. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 75e44551ef..04ec06d251 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4355,7 +4355,7 @@ of." (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))) (defun tramp-handle-write-region - (start end filename &optional append visit lockname mustbenew) + (start end filename &optional append visit _lockname mustbenew) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil @@ -4386,7 +4386,7 @@ of." ;; We say `no-message' here because we don't want the visited file ;; modtime data to be clobbered from the temp file. We call ;; `set-visited-file-modtime' ourselves later on. - (write-region start end tmpfile append 'no-message lockname) + (write-region start end tmpfile append 'no-message) (condition-case nil (rename-file tmpfile filename 'ok-if-already-exists) (error diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 7c9d05ac1c..84a9479480 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -70,7 +70,7 @@ "Temporary directory for Tramp tests.") (setq password-cache-expiry nil - shadow-debug (getenv "EMACS_HYDRA_CI") + shadow-debug (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) tramp-verbose 0 ;; When the remote user id is 0, Tramp refuses unsafe temporary files. tramp-allow-unsafe-temporary-files commit f7dcad927521279cf750cbf25988671f7198bc4c Author: Martin Rudalics Date: Mon Jul 5 10:53:39 2021 +0200 Show hand cursor when dragging frame (Bug#49247) * src/xdisp.c (note_mode_line_or_margin_highlight): Show hand cursor when dragging frame with mode, tab or header line. (syms_of_xdisp): Define Qdrag_with_mode_line, Qdrag_with_header_line and Qdrag_with_tab_line. diff --git a/src/xdisp.c b/src/xdisp.c index c30084cc8b..8f4dfa5430 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -33236,7 +33236,8 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, of the mode line without any text (e.g. past the right edge of the mode line text), use that windows's mode line help echo if it has been set. */ - if (STRINGP (string) || area == ON_MODE_LINE) + if (STRINGP (string) || area == ON_MODE_LINE || area == ON_HEADER_LINE + || area == ON_TAB_LINE) { /* Arrange to display the help by setting the global variables help_echo_string, help_echo_object, and help_echo_pos. */ @@ -33293,6 +33294,19 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, } else if (draggable && area == ON_MODE_LINE) cursor = FRAME_OUTPUT_DATA (f)->vertical_drag_cursor; + else if ((area == ON_MODE_LINE + && WINDOW_BOTTOMMOST_P (w) + && !FRAME_HAS_MINIBUF_P (f) + && !NILP (Fframe_parameter + (w->frame, Qdrag_with_mode_line))) + || (((area == ON_HEADER_LINE + && !NILP (Fframe_parameter + (w->frame, Qdrag_with_header_line))) + || (area == ON_TAB_LINE + && !NILP (Fframe_parameter + (w->frame, Qdrag_with_tab_line)))) + && WINDOW_TOPMOST_P (w))) + cursor = FRAME_OUTPUT_DATA (f)->hand_cursor; else cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; } @@ -34882,6 +34896,10 @@ be let-bound around code that needs to disable messages temporarily. */); DEFSYM (Qdragging, "dragging"); DEFSYM (Qdropping, "dropping"); + DEFSYM (Qdrag_with_mode_line, "drag-with-mode-line"); + DEFSYM (Qdrag_with_header_line, "drag-with-header-line"); + DEFSYM (Qdrag_with_tab_line, "drag-with-tab-line"); + DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces"); list_of_error = list1 (list2 (Qerror, Qvoid_variable)); commit ddf6226350934a9e9ffe436d46141c752eb440b7 Author: Michael Albinus Date: Mon Jul 5 10:24:31 2021 +0200 Fix newly introduced error in tramp-tests.el (Bug#49406) * test/lisp/net/tramp-tests.el (tramp--test-check-files): Filter out empty strings. (Bug#49406) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 6aa8629f33..7f894448a6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5935,7 +5935,9 @@ This requires restrictions of file name syntax." (file-truename tramp-test-temporary-file-directory)) (tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name 'local quoted)) - (files (delq nil files)) + (files + (delq + nil (mapcar (lambda (x) (unless (string-empty-p x) x)) files))) (process-environment process-environment) (sorted-files (sort (copy-sequence files) #'string-lessp)) buffer) @@ -5945,7 +5947,7 @@ This requires restrictions of file name syntax." (make-directory tmp-name2) (dolist (elt files) - ;(tramp--test-message "%s" elt) + ;(tramp--test-message "'%s'" elt) (let* ((file1 (expand-file-name elt tmp-name1)) (file2 (expand-file-name elt tmp-name2)) (file3 (expand-file-name (concat elt "foo") tmp-name1))) commit ed15f3954c04e2039a565ca0d0ff810519da8197 Author: Lars Ingebrigtsen Date: Sun Jul 4 16:23:46 2021 +0200 Ignore .dir-locals-2.el files more * lisp/emacs-lisp/shadow.el (load-path-shadows-find): * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): Ignore .dir-locals-2.el, too (bug#23257). diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3e65db4242..70999648d4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1857,8 +1857,7 @@ also be compiled." (file-readable-p source) (not (string-match "\\`\\.#" file)) (not (auto-save-file-name-p source)) - (not (string-equal dir-locals-file - (file-name-nondirectory source)))) + (not (member source (dir-locals--all-files directory)))) (progn (cl-incf (pcase (byte-recompile-file source force arg) ('no-byte-compile skip-count) diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index c1d0594123..02f2ad3d81 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -115,9 +115,12 @@ See the documentation for `list-load-path-shadows' for further information." ;; FILE now contains the current file name, with no suffix. (unless (or (member file files-seen-this-dir) ;; Ignore these files. - (member file (list "subdirs" "leim-list" - (file-name-sans-extension - dir-locals-file)))) + (member file + (list "subdirs" "leim-list" + (file-name-sans-extension dir-locals-file) + (concat + (file-name-sans-extension dir-locals-file) + "-2")))) ;; File has not been seen yet in this directory. ;; This test prevents us declaring that XXX.el shadows ;; XXX.elc (or vice-versa) when they are in the same directory. commit 2f2afa0b310bbce43a8703f5467b2638082abdd9 Author: Jim Porter Date: Sun Jul 4 15:32:03 2021 +0200 Ensure 'call-process' interprets INFILE as a local path * src/callproc.c (get_current_directory): Rename from 'encode_current_directory' and add boolean ENCODE flag. (Fcall_process): Interpret INFILE relative to the working directory from which PROGRAM is run, not 'default-directory'. (call_process): Use 'get_current_directory'. * src/process.c (Fmake_process): Use 'get_current_directory'. * src/process.h (get_current_directory): Rename decl from 'encode_current_directory'. * src/sysdep.c (sys_subshell): Use 'get_current_directory' (bug#49283). diff --git a/src/callproc.c b/src/callproc.c index aabc39313b..675b78daf3 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -116,11 +116,13 @@ static CHILD_SETUP_TYPE child_setup (int, int, int, char **, char **, const char *); /* Return the current buffer's working directory, or the home - directory if it's unreachable, as a string suitable for a system call. - Signal an error if the result would not be an accessible directory. */ + directory if it's unreachable. If ENCODE is true, return as a string + suitable for a system call; otherwise, return a string in its + internal representation. Signal an error if the result would not be + an accessible directory. */ Lisp_Object -encode_current_directory (void) +get_current_directory (bool encode) { Lisp_Object curdir = BVAR (current_buffer, directory); Lisp_Object dir = Funhandled_file_name_directory (curdir); @@ -131,12 +133,12 @@ encode_current_directory (void) dir = build_string ("~"); dir = expand_and_dir_to_file (dir); - dir = ENCODE_FILE (remove_slash_colon (dir)); + Lisp_Object encoded_dir = ENCODE_FILE (remove_slash_colon (dir)); - if (! file_accessible_directory_p (dir)) + if (! file_accessible_directory_p (encoded_dir)) report_file_error ("Setting current directory", curdir); - return dir; + return encode ? encoded_dir : dir; } /* If P is reapable, record it as a deleted process and kill it. @@ -225,8 +227,9 @@ DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0, The remaining arguments are optional. The program's input comes from file INFILE (nil means `null-device'). -If you want to make the input come from an Emacs buffer, use -`call-process-region' instead. +If INFILE is a relative path, it will be looked for relative to the +directory where the process is run (see below). If you want to make the +input come from an Emacs buffer, use `call-process-region' instead. Third argument DESTINATION specifies how to handle program's output. If DESTINATION is a buffer, or t that stands for the current buffer, @@ -270,7 +273,9 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * if (nargs >= 2 && ! NILP (args[1])) { - infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory)); + /* Expand infile relative to the current buffer's current + directory, or its unhandled equivalent ("~"). */ + infile = Fexpand_file_name (args[1], get_current_directory (false)); CHECK_STRING (infile); } else @@ -439,7 +444,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, buffer's current directory, or its unhandled equivalent. We can't just have the child check for an error when it does the chdir, since it's in a vfork. */ - current_dir = encode_current_directory (); + current_dir = get_current_directory (true); if (STRINGP (error_file)) { diff --git a/src/process.c b/src/process.c index c354f3a90d..b8c3e4ecfb 100644 --- a/src/process.c +++ b/src/process.c @@ -1755,7 +1755,7 @@ usage: (make-process &rest ARGS) */) buffer's current directory, or its unhandled equivalent. We can't just have the child check for an error when it does the chdir, since it's in a vfork. */ - current_dir = encode_current_directory (); + current_dir = get_current_directory (true); name = Fplist_get (contact, QCname); CHECK_STRING (name); diff --git a/src/process.h b/src/process.h index 0890f253a4..4a25d13d26 100644 --- a/src/process.h +++ b/src/process.h @@ -264,7 +264,7 @@ enum /* Defined in callproc.c. */ -extern Lisp_Object encode_current_directory (void); +extern Lisp_Object get_current_directory (bool); extern void record_kill_process (struct Lisp_Process *, Lisp_Object); /* Defined in sysdep.c. */ diff --git a/src/sysdep.c b/src/sysdep.c index 51d8b5eeed..b8ec22d9dd 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -657,7 +657,7 @@ sys_subshell (void) #endif pid_t pid; struct save_signal saved_handlers[5]; - char *str = SSDATA (encode_current_directory ()); + char *str = SSDATA (get_current_directory (true)); #ifdef DOS_NT pid = 0; commit 46d4ddd1767284e8a42b01e7880c2658c5957ab1 Author: Lars Ingebrigtsen Date: Fri Jul 2 17:33:37 2021 +0200 Adjust eshell and ps-print to not use emacs-kill-hook * lisp/ps-print.el (ps-kill-emacs-check): * lisp/eshell/em-dirs.el (eshell-dirs-initialize) (eshell-save-some-last-dir): Don't use `emacs-kill-hook' (bug#28943). * lisp/eshell/em-hist.el (eshell-hist-initialize) (eshell-save-some-history): diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index c04a1a67d5..ee9057f50e 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -224,7 +224,7 @@ Thus, this does not include the current directory.") (add-hook 'eshell-exit-hook #'eshell-write-last-dir-ring nil t) - (add-hook 'kill-emacs-hook #'eshell-save-some-last-dir)) + (add-hook 'kill-emacs-query-functions #'eshell-save-some-last-dir)) (defun eshell-save-some-last-dir () "Save the list-dir-ring for any open Eshell buffers." @@ -238,7 +238,8 @@ Thus, this does not include the current directory.") (format-message "Save last dir ring for Eshell buffer `%s'? " (buffer-name buf))))) - (eshell-write-last-dir-ring)))))) + (eshell-write-last-dir-ring))))) + t) (defun eshell-lone-directory-p (file) "Test whether FILE is just a directory name, and not a command name." diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 18e19a9d9a..d82946add0 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -293,7 +293,7 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (add-hook 'eshell-exit-hook #'eshell-write-history nil t) - (add-hook 'kill-emacs-hook #'eshell-save-some-history) + (add-hook 'kill-emacs-query-functions #'eshell-save-some-history) (add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t)) @@ -310,7 +310,8 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (format-message "Save input history for Eshell buffer `%s'? " (buffer-name buf))))) - (eshell-write-history)))))) + (eshell-write-history))))) + t) (defun eshell/history (&rest args) "List in help buffer the buffer's input history." diff --git a/lisp/ps-print.el b/lisp/ps-print.el index fcc6e1fd83..1b8654ead2 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -6506,10 +6506,11 @@ If FACE is not a valid face name, use default face." (and (buffer-live-p ps-buffer) (buffer-modified-p ps-buffer) (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")) - (error "Unprinted PostScript")))) + (error "Unprinted PostScript"))) + t) (unless noninteractive - (add-hook 'kill-emacs-hook #'ps-kill-emacs-check)) + (add-hook 'kill-emacs-query-functions #'ps-kill-emacs-check)) (provide 'ps-print) commit 3dae1e42e107938ec9d7c93efec2453e7d23ab5b Author: Eli Zaretskii Date: Sun Jul 4 15:04:52 2021 +0300 * lisp/url/url-util.el (url-unhex-string): Doc fix. diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 7c913bcb1a..8b79736d00 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -335,10 +335,13 @@ instead of just \"key\" as in the example above." ;;;###autoload (defun url-unhex-string (str &optional allow-newlines) - "Remove %XX embedded spaces, etc in a URL. + "Decode %XX sequences in a percent-encoded URL. If optional second argument ALLOW-NEWLINES is non-nil, then allow the decoding of carriage returns and line feeds in the string, which is normally -forbidden in URL encoding." +forbidden in URL encoding. + +The resulting string in general requires decoding using an +appropriate coding-system; see `decode-coding-string'." (setq str (or str "")) (let ((tmp "") (case-fold-search t)) commit 31ed5a8c12b23011d23ccaec2b7a8d532013c83e Author: Eli Zaretskii Date: Sun Jul 4 14:55:42 2021 +0300 Avoid deprecation warnings with Texinfo 6.8 * doc/lispref/functions.texi (Function Safety): * doc/misc/srecode.texi (Parts of SRecode): * doc/misc/wisent.texi (Wisent Semantic, Wisent Lex): * doc/misc/pcl-cvs.texi (Editing files): * doc/misc/bovine.texi (top, Starting Rules) (Bovine Grammar Rules, How Lexical Tokens Match) (Optional Lambda Expression): * doc/emacs/msdos.texi (Windows Keyboard): * doc/emacs/buffers.texi (Several Buffers): * doc/emacs/text.texi (Text): Avoid using @inforef, which is deprecated. diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index bec7f37547..c4e5bc32b7 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -586,9 +586,6 @@ every @code{auto-revert-interval} seconds if you enable Auto Revert mode in this buffer, as long as it is not marked modified. Global Auto Revert mode applies to the @file{*Buffer List*} buffer only if @code{global-auto-revert-non-file-buffers} is non-@code{nil}. -@iftex -@inforef{Auto Reverting the Buffer Menu,, emacs-xtra}, for details. -@end iftex @ifnottex @xref{Auto Reverting the Buffer Menu, global-auto-revert-non-file-buffers}, for details. @end ifnottex diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index 4b58f6aa2f..33d389acd5 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -549,10 +549,6 @@ meanings by enabling CUA Mode (@pxref{CUA Bindings}). Another optional feature which will make Emacs behave like other Windows applications is Delete Selection mode (@pxref{Using Region}). -@iftex -@inforef{Windows Keyboard, , emacs}, for information about additional -Windows-specific variables in this category. -@end iftex @ifnottex @vindex w32-alt-is-meta @cindex @code{Alt} key (MS-Windows) @@ -1176,11 +1172,6 @@ the default when such software is detected when running Emacs. When this variable is non-@code{nil}, other variables affecting the cursor display have no effect. -@iftex -@inforef{Windows Misc, , emacs}, for information about additional -Windows-specific variables in this category. -@end iftex - @ifnottex @vindex w32-grab-focus-on-raise @cindex frame focus policy, MS-Windows diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index f2fe248015..c9c4be3c61 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -61,7 +61,7 @@ use Picture mode, a special major mode for editing such pictures. @cindex autotyping @cindex automatic typing The automatic typing features may be useful when writing text. -@inforef{Top,The Autotype Manual,autotype}. +@xref{Top, Autotyping, The Autotype Manual, autotype}. @end ifinfo @menu diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 64883bf0f6..77d1465c87 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2421,11 +2421,12 @@ opposed to an unspecified one). @cindex safety of functions Some major modes, such as SES, call functions that are stored in user -files. (@inforef{Top, ,ses}, for more information on SES@.) User -files sometimes have poor pedigrees---you can get a spreadsheet from -someone you've just met, or you can get one through email from someone -you've never met. So it is risky to call a function whose source code -is stored in a user file until you have determined that it is safe. +files. (@xref{Top, Simple Emacs Spreadsheet,,ses}, for more +information on SES@.) User files sometimes have poor pedigrees---you +can get a spreadsheet from someone you've just met, or you can get one +through email from someone you've never met. So it is risky to call a +function whose source code is stored in a user file until you have +determined that it is safe. @defun unsafep form &optional unsafep-vars Returns @code{nil} if @var{form} is a @dfn{safe} Lisp expression, or diff --git a/doc/misc/bovine.texi b/doc/misc/bovine.texi index 780f0addb5..9bfb117d1a 100644 --- a/doc/misc/bovine.texi +++ b/doc/misc/bovine.texi @@ -78,13 +78,13 @@ The @dfn{bovine} parser is the original @semantic{} parser, and is an implementation of an @acronym{LL} parser. It is good for simple languages. It has many conveniences making grammar writing easy. The conveniences make it less powerful than a Bison-like @acronym{LALR} -parser. For more information, @inforef{Top, The Wisent Parser Manual, +parser. For more information, @pxref{Top,, Wisent Parser Development, wisent}. Bovine @acronym{LL} grammars are stored in files with a @file{.by} extension. When compiled, the contents is converted into a file of the form @file{NAME-by.el}. This, in turn is byte compiled. -@inforef{top, Grammar Framework Manual, grammar-fw}. +@xref{top,, Grammar Framework Manual, grammar-fw}. @ifnottex @insertcopying @@ -105,7 +105,8 @@ the form @file{NAME-by.el}. This, in turn is byte compiled. In Bison, one and only one nonterminal is designated as the ``start'' symbol. In @semantic{}, one or more nonterminals can be designated as the ``start'' symbol. They are declared following the @code{%start} -keyword separated by spaces. @inforef{start Decl, ,grammar-fw}. +keyword separated by spaces. @xref{start Decl,, Grammar Framework +Manual, grammar-fw}. If no @code{%start} keyword is used in a grammar, then the very first is used. Internally the first start nonterminal is targeted by the @@ -115,7 +116,8 @@ parser harness. To find locally defined variables, the local context handler needs to parse the body of functional code. The @code{scopestart} declaration specifies the name of a nonterminal used as the goal to parse a local -context, @inforef{scopestart Decl, ,grammar-fw}. Internally the +context, @pxref{scopestart Decl,, Grammar Framework Manual, +grammar-fw}. Internally the scopestart nonterminal is targeted by the reserved symbol @code{bovine-inner-scope}, so it can be found by the parser harness. @@ -124,7 +126,7 @@ scopestart nonterminal is targeted by the reserved symbol The rules are what allow the compiler to create tags from a language file. Once the setup is done in the prologue, you can start writing -rules. @inforef{Grammar Rules, ,grammar-fw}. +rules. @xref{Grammar Rules,, Grammar Framework Manual, grammar-fw}. @example @var{result} : @var{components1} @var{optional-semantic-action1}) @@ -146,8 +148,8 @@ A particular @var{result} written into your grammar becomes the parser's goal. It is designated by a @code{%start} statement (@pxref{Starting Rules}). The value returned by the associated @var{optional-semantic-action} is the parser's result. It should be -a tree of @semantic{} @dfn{tags}, @inforef{Semantic Tags, , -semantic-appdev}. +a tree of @semantic{} @dfn{tags}, @pxref{Semantic Tags,, Semantic +Application Development, semantic-appdev}. @var{components} is made up of symbols. A symbol such as @code{FOO} means that a syntactic token of class @code{FOO} must be matched. @@ -170,8 +172,9 @@ For instance: @end example Means that @code{FOO} is a reserved language keyword, matched as such -by looking up into a keyword table, @inforef{keyword Decl, -,grammar-fw}. This is because @code{"foo"} will be converted to +by looking up into a keyword table, @pxref{keyword Decl,, Grammar +Framework Manual, grammar-fw}. This is because @code{"foo"} will be +converted to @code{FOO} in the lexical analysis stage. Thus the symbol @code{FOO} won't be available any other way. @@ -383,8 +386,8 @@ Is an optional set of labeled values such as @code{:constant-flag t :parent Create a tag with @var{name} of respectively the class @code{variable}, @code{function}, @code{type}, @code{include}, @code{package}, and @code{code}. -See @inforef{Creating Tags, , semantic-appdev} for the lisp -functions these translate into. +See @ref{Creating Tags,, Semantic Application Development, +semantic-appdev}, for the lisp functions these translate into. @end table If the symbol @code{%quotemode backquote} is specified, then use diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index 0d4f976911..4ba067fd81 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -839,7 +839,7 @@ files. @item f Find the file that the cursor points to (@code{cvs-mode-find-file}). If the cursor points to a directory, run @code{dired} on that directory; -@inforef{Dired, , emacs}. +@pxref{Dired, Emacs Manual, , emacs}. @item o Like @kbd{f}, but use another window diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi index a0e999b681..1f7473c151 100644 --- a/doc/misc/srecode.texi +++ b/doc/misc/srecode.texi @@ -259,7 +259,7 @@ contexts to have the same name. Some standard contexts are @code{file}, @code{declaration}, and @code{classdecl}. A context can be automatically derived as well based on the parsing -state from @i{Semantic}. @inforef{Top, Semantic Manual, semantic}. +state from @i{Semantic}. @xref{Top, Semantic Manual,, semantic}. @section Applications Commands that do a particular user task which involves also writing diff --git a/doc/misc/wisent.texi b/doc/misc/wisent.texi index dc5b8e4d20..c0bb7b10a4 100644 --- a/doc/misc/wisent.texi +++ b/doc/misc/wisent.texi @@ -1575,7 +1575,7 @@ To use the Wisent parser with @semantic{} you have to define your grammar in @dfn{WY} form, a grammar format very close to the one used by Bison. -Please @inforef{top, Semantic Grammar Framework Manual, grammar-fw} +Please see @ref{top, Semantic Grammar Framework Manual,, grammar-fw}, for more information on @semantic{} grammars. @menu @@ -1962,8 +1962,8 @@ See implementation of the function @code{wisent-skip-token} in @findex semantic-lex The lexical analysis step of @semantic{} is performed by the general -function @code{semantic-lex}. For more information, @inforef{Writing -Lexers, ,semantic-langdev}. +function @code{semantic-lex}. For more information, see @ref{Writing +Lexers, Semantic Language Development,,semantic-langdev}. @code{semantic-lex} produces lexical tokens of the form: commit 28fcdb521922db56a30f75f7d3e656fcb8ef6bd7 Author: Alan Third Date: Mon Jun 28 19:50:31 2021 +0100 Fix crash in GNUstep font coverage check * src/nsfont.m (ns_charset_covers): Check coverage more accurately and don't automatically assume the buffer is 8192 bytes long. diff --git a/src/nsfont.m b/src/nsfont.m index 06e10d52be..5a9cdfebc0 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -277,30 +277,36 @@ static void ns_glyph_metrics (struct nsfont_info *font_info, /* Return whether set1 covers set2 to a reasonable extent given by pct. - We check, out of each 16 Unicode char range containing chars in set2, - whether at least one character is present in set1. - This must be true for pct of the pairs to consider it covering. */ + + The GNUstep bitmap representation doesn't match Apple's + description. It appears to be a single block of bytes, not broken + up into planes, where the last byte contains the highest character + the character set supports. */ static BOOL ns_charset_covers(NSCharacterSet *set1, NSCharacterSet *set2, float pct) { - const unsigned short *bytes1 = [[set1 bitmapRepresentation] bytes]; - const unsigned short *bytes2 = [[set2 bitmapRepresentation] bytes]; - int i, off = 0, tot = 0; + NSData *font = [set1 bitmapRepresentation]; + NSData *script = [set2 bitmapRepresentation]; - /* Work around what appears to be a GNUstep bug. - See . */ - if (! (bytes1 && bytes2)) - return NO; + uint8_t *fontPlane = (uint8_t *)[font bytes]; + uint8_t *scriptPlane = (uint8_t *)[script bytes]; - for (i=0; i<4096; i++, bytes1++, bytes2++) - if (*bytes2) - { - tot++; - if (*bytes1 == 0) // *bytes1 & *bytes2 != *bytes2 - off++; - } - // fprintf(stderr, "off = %d\ttot = %d\n", off,tot); - return (float)off / tot < 1.0F - pct; + int covered = 0, total = 0; + + for (ptrdiff_t b = 0 ; b < [script length] ; b++) + for (int i = 0 ; i < 8 ; i++) + { + if (*(scriptPlane + b) & (1 << i)) + { + total++; + + if (b < [font length] + && *(fontPlane + b) & (1 << i)) + covered++; + } + } + + return (float)covered / total >= 1.0F - pct; } commit 0382aa114844c275467f62474497dd294688c52c Author: Alan Third Date: Sat Jun 26 15:39:19 2021 +0100 Remove unused variables * src/nsterm.m ([EmacsView keyDown:]): Remove ns_fake_keydown as there's no code that ever sets it to YES. diff --git a/src/nsterm.m b/src/nsterm.m index dc5ecc4564..b9e2c9b691 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -277,11 +277,9 @@ - (NSColor *)colorUsingDefaultColorSpace #endif static int ns_window_num = 0; static BOOL gsaved = NO; -static BOOL ns_fake_keydown = NO; #ifdef NS_IMPL_COCOA static BOOL ns_menu_bar_is_hidden = NO; #endif -/* static int debug_lock = 0; */ /* event loop */ static BOOL send_appdefined = YES; @@ -6293,9 +6291,7 @@ - (void)keyDown: (NSEvent *)theEvent NSTRACE ("[EmacsView keyDown:]"); /* Rhapsody and macOS give up and down events for the arrow keys. */ - if (ns_fake_keydown == YES) - ns_fake_keydown = NO; - else if ([theEvent type] != NSEventTypeKeyDown) + if ([theEvent type] != NSEventTypeKeyDown) return; if (!emacs_event) commit 604133ee62b7475f5aa88bd0b2ad9f81145f4ec5 Author: Alan Third Date: Tue Jun 22 21:46:02 2021 +0100 Fix thread memory management under NS * src/thread.c (run_thread): Allocate an autorelease pool so that any autoreleased Objective C objects are correctly released. diff --git a/src/thread.c b/src/thread.c index f74f611148..714b1cd903 100644 --- a/src/thread.c +++ b/src/thread.c @@ -28,6 +28,10 @@ along with GNU Emacs. If not, see . */ #include "pdumper.h" #include "keyboard.h" +#ifdef HAVE_NS +#include "nsterm.h" +#endif + #if defined HAVE_GLIB && ! defined (HAVE_NS) #include #else @@ -735,6 +739,15 @@ run_thread (void *state) struct thread_state *self = state; struct thread_state **iter; +#ifdef HAVE_NS + /* Allocate an autorelease pool in case this thread calls any + Objective C code. + + FIXME: In long running threads we may want to drain the pool + regularly instead of just at the end. */ + void *pool = ns_alloc_autorelease_pool (); +#endif + self->m_stack_bottom = self->stack_top = &stack_pos.c; self->thread_id = sys_thread_self (); @@ -777,6 +790,10 @@ run_thread (void *state) current_thread = NULL; sys_cond_broadcast (&self->thread_condvar); +#ifdef HAVE_NS + ns_release_autorelease_pool (pool); +#endif + /* Unlink this thread from the list of all threads. Note that we have to do this very late, after broadcasting our death. Otherwise the GC may decide to reap the thread_state object, commit 7a13ddfda0b52d17d845ad390faa3c16005ef453 Author: Amin Bandali Date: Sun Jul 4 01:18:19 2021 -0400 Update a few more IRC-related references to point to Libera.Chat diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index cc54ca3f54..10ced678e1 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -554,7 +554,7 @@ for the values of the other parameters, and @code{client-certificate} will be @code{nil}. @example -(erc-tls :server "chat.freenode.net" :full-name "J. Random Hacker") +(erc-tls :server "irc.libera.chat" :full-name "J. Random Hacker") @end example To use a certificate with @code{erc-tls}, specify the optional @@ -572,21 +572,21 @@ various IRC networks. Examples of use: @example -(erc-tls :server "chat.freenode.net" :port 6697 +(erc-tls :server "irc.libera.chat" :port 6697 :client-certificate '("/home/bandali/my-cert.key" "/home/bandali/my-cert.crt")) @end example @example -(erc-tls :server "chat.freenode.net" :port 6697 +(erc-tls :server "irc.libera.chat" :port 6697 :client-certificate - `(,(expand-file-name "~/cert-freenode.key") - ,(expand-file-name "~/cert-freenode.crt"))) + `(,(expand-file-name "~/cert-libera.key") + ,(expand-file-name "~/cert-libera.crt"))) @end example @example -(erc-tls :server "chat.freenode.net" :port 6697 +(erc-tls :server "irc.libera.chat" :port 6697 :client-certificate t) @end example @@ -595,7 +595,7 @@ line like the following to your authinfo file (e.g. @file{~/.authinfo.gpg}): @example -machine chat.freenode.net key /home/bandali/my-cert.key cert /home/bandali/my-cert.crt +machine irc.libera.chat key /home/bandali/my-cert.key cert /home/bandali/my-cert.crt @end example @xref{Help for users,,,auth, Emacs auth-source Library}, for more on the diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7d8d97632f..026c6f8416 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2260,7 +2260,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc-tls :server \"chat.freenode.net\" :full-name \"J. Random Hacker\") + (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") then the server and full-name will be set to those values, whereas `erc-compute-port' and `erc-compute-nick' will be invoked @@ -2276,7 +2276,7 @@ authentication by various IRC networks. Example usage: - (erc-tls :server \"chat.freenode.net\" :port 6697 + (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate '(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\"))" diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 89154ae895..efaf061f31 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -10888,7 +10888,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc :server \"chat.freenode.net\" :full-name \"J. Random Hacker\") + (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") then the server and full-name will be set to those values, whereas `erc-compute-port' and `erc-compute-nick' will be invoked @@ -10915,7 +10915,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc-tls :server \"chat.freenode.net\" :full-name \"J. Random Hacker\") + (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") then the server and full-name will be set to those values, whereas `erc-compute-port' and `erc-compute-nick' will be invoked @@ -10931,7 +10931,7 @@ authentication by various IRC networks. Example usage: - (erc-tls :server \"chat.freenode.net\" :port 6697 + (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate '(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\")) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index f1ec5224c7..e502cbb3dc 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -362,7 +362,7 @@ From, and Cc against HEADER-REGEXP in (defvar bug-reference-setup-from-irc-alist `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc" "erc") 'words)) - "freenode" + "Libera.Chat" "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" "https://debbugs.gnu.org/%s")) "An alist for setting up `bug-reference-mode' in IRC modes. @@ -377,8 +377,8 @@ Each element has the form CHANNEL-REGEXP is a regexp matched against the current IRC channel name (e.g. #emacs). NETWORK-REGEXP is matched against -the IRC network name (e.g. freenode). Both entries are optional. -If all given entries match, BUG-REGEXP is set as +the IRC network name (e.g. Libera.Chat). Both entries are +optional. If all given entries match, BUG-REGEXP is set as `bug-reference-bug-regexp' and URL-FORMAT is set as `bug-reference-url-format'.") commit 8d957f2dd8b026ec0d7178222c0e5d9f82a2b91e Merge: 136b30b0c4 348b2aed0c Author: Amin Bandali Date: Sun Jul 4 00:14:47 2021 -0400 Merge from origin/emacs-27 348b2aed0c Update IRC-related references to point to Libera.Chat b0e725e2fe Fix typo in c-macro-expand docstring # Conflicts: # doc/misc/erc.texi # doc/misc/gnus-faq.texi # doc/misc/rcirc.texi # etc/NEWS # lisp/erc/erc-services.el # lisp/erc/erc.el # lisp/ldefs-boot.el # lisp/net/rcirc.el commit 136b30b0c44d30d642afa2ce00d804305eca3c23 Merge: 5d1cf01d53 d70dc6946a Author: Amin Bandali Date: Sun Jul 4 00:12:58 2021 -0400 ; Merge from origin/emacs-27 The following commit was skipped: d70dc6946a ; Auto-commit of loaddefs files. commit 5d1cf01d537ee381a204c96b28b7daa1eadf3f8e Merge: 9b318d5c58 d898d3c73a Author: Amin Bandali Date: Sun Jul 4 00:12:57 2021 -0400 Merge from origin/emacs-27 d898d3c73a ; * doc/emacs/back.texi: Fix a typo. de52dbd4ad Update doc/emacs/ for a new printing of the Emacs Manual book commit 348b2aed0c8c3630be4c15c8e70acf7ea9c023af Author: Amin Bandali Date: Sat Jul 3 23:39:18 2021 -0400 Update IRC-related references to point to Libera.Chat Per GNU and FSF's announcements [0, 1] of moving official IRC channels to the Libera.Chat IRC network, as well as several Emacs-related channels following suit [2], update IRC-related references to reflect the migration. [0]: https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html [1]: https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html [2]: https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index d39613c11a..951535fa31 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -131,21 +131,30 @@ customize-variable @key{RET} erc-modules @key{RET}}. @node Sample Session @section Sample Session -This is an example ERC session which shows how to connect to the #emacs -channel on Freenode. Another IRC channel on Freenode that may be of -interest is #erc, which is a channel where ERC users and developers hang -out. +This is an example ERC session which shows how to connect to the +#emacs channel on Libera.Chat. Another IRC channel on Libera.Chat +that may be of interest is #erc, which is a channel where ERC users +and developers hang out. These channels used to live on the Freenode +IRC network until June 2021, when they---along with the official IRC +channels of the GNU Project, the Free Software Foundation, and many +other free software communities---relocated to the Libera.Chat network +in the aftermath of changes in governance and policies of Freenode in +May and June 2021. GNU and FSF's announcements about this are at +@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html}, +@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html}, +and +@uref{https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html}. @itemize @bullet -@item Connect to Freenode +@item Connect to Libera.Chat -Run @kbd{M-x erc}. Use ``irc.freenode.net'' as the IRC server, ``6667'' +Run @kbd{M-x erc}. Use ``irc.libera.chat as the IRC server, ``6667'' as the port, and choose a nickname. @item Get used to the interface -Switch to the ``irc.freenode.net:6667'' buffer, if you're not already +Switch to the ``irc.libera.chat:6667'' buffer, if you're not already there. You will see first some messages about checking for ident, and then a bunch of other messages that describe the current IRC server. @@ -158,13 +167,14 @@ background. If the latter, switch to the ``#emacs'' buffer. You will see the channel topic and a list of the people who are currently on the channel. -@item Register your nickname with Freenode +@item Register your nickname with Libera.Chat If you would like to be able to talk with people privately on the -Freenode network, you will have to ``register'' your nickname. To do -so, switch to the ``irc.freenode.net:6667'' buffer and type ``/msg -NickServ register '', replacing ``'' with your -desired password. It should tell you that the operation was successful. +Libera.Chat network, you will have to ``register'' your nickname. +To do so, switch to the ``irc.libera.chat:6667'' buffer and type +``/msg NickServ register '', replacing ``'' with +your desired password. It should tell you that the operation was +successful. @item Talk to people in the channel @@ -518,7 +528,7 @@ That is, if called with the following arguments, @var{server} and parameters. @example -(erc :server "irc.freenode.net" :full-name "Harry S Truman") +(erc :server "irc.libera.chat" :full-name "J. Random Hacker") @end example @end defun @@ -691,10 +701,10 @@ stuff, to the current ERC buffer." (erc-send-message (concat "@{Uptime@} [" uname-output "]")))) -;; This causes ERC to connect to the Freenode network upon hitting +;; This causes ERC to connect to the Libera.Chat network upon hitting ;; C-c e f. Replace MYNICK with your IRC nick. (global-set-key "\C-cef" (lambda () (interactive) - (erc :server "irc.freenode.net" :port "6667" + (erc :server "irc.libera.chat" :port "6667" :nick "MYNICK"))) ;; This causes ERC to connect to the IRC server on your own machine (if @@ -714,13 +724,15 @@ stuff, to the current ERC buffer." ;;; Options -;; Join the #emacs and #erc channels whenever connecting to Freenode. -(setq erc-autojoin-channels-alist '(("freenode.net" "#emacs" "#erc"))) +;; Join the #emacs and #erc channels whenever connecting to +;; Libera.Chat. +(setq erc-autojoin-channels-alist + '(("Libera.Chat" "#emacs" "#erc"))) ;; Rename server buffers to reflect the current network name instead -;; of SERVER:PORT (e.g., "freenode" instead of "irc.freenode.net:6667"). -;; This is useful when using a bouncer like ZNC where you have multiple -;; connections to the same server. +;; of SERVER:PORT (e.g., "Libera.Chat" instead of +;; "irc.libera.chat:6667"). This is useful when using a bouncer like +;; ZNC where you have multiple connections to the same server. (setq erc-rename-buffers t) ;; Interpret mIRC-style color commands in IRC chats @@ -760,7 +772,7 @@ If non, @code{nil}, this is a list of IRC networks and message types to hide, e.g.: @example -(setq erc-network-hide-list (("freenode" "JOIN" "PART" "QUIT") +(setq erc-network-hide-list (("Libera.Chat" "JOIN" "PART" "QUIT") ("OFTC" "JOIN" "PART"")) @end example @end defopt @@ -809,7 +821,7 @@ You can ask questions about using ERC on the Emacs mailing list, @uref{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs}. @item -You can visit the IRC Freenode channel @samp{#emacs}. Many of the +You can visit the IRC Libera.Chat channel @samp{#emacs}. Many of the contributors are frequently around and willing to answer your questions. diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 96503138e5..455819745d 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -2144,7 +2144,7 @@ I need real-time help, where to find it? @subsubheading Answer -Point your IRC client to irc.freenode.net, channel #gnus. +Point your IRC client to irc.libera.chat, channel #gnus. @node FAQ 9 - Tuning Gnus @subsection Tuning Gnus diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index 85eab4c443..c636cdee15 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -124,10 +124,11 @@ server in a network, and servers relay messages from one to the next. Here's a typical example: @cindex redirection to random servers -When you connect to the Freenode network -(@code{http://freenode.net/}), you point your IRC client at the -server @code{irc.freenode.net}. That server will redirect your client -to a random server on the network, such as @code{zelazny.freenode.net}. +When you connect to the Libera.Chat network +(@code{https://libera.chat}), you point your IRC client at the +server @code{irc.libera.chat}. That server will redirect your client +to a random server on the network, such as +@code{zirconium.libera.chat}. @cindex channel name @cindex # starts a channel name @@ -171,15 +172,23 @@ using a different nick. This will prompt you for four things: @table @asis @cindex server, connecting -@cindex Freenode network +@cindex Libera.Chat network @item IRC Server What server do you want to connect to? All the servers in a particular -network are equivalent. Some networks use a round-robin system where a -single server redirects new connections to a random server in the -network. @code{irc.freenode.net} is such a server for the Freenode -network. Freenode provides the network ``for the Free and Open Source -Software communities, for not-for-profit organizations and for related -communities and organizations.'' +network are equivalent. Some networks use a round-robin system where +a single server redirects new connections to a random server in the +network. @code{irc.libera.chat} is such a server for the Libera.Chat +network. Libera.Chat's purpose is ``to provide services such as a +community platform for free open-source software and peer directed +projects on a volunteer basis,'' and was chosen as the official home +of the GNU Project and the Free Software Foundation's IRC channels in +June 2021 in the aftermath of the changes in governance and policies +of the Freenode IRC network. GNU and FSF's announcements about this +are at +@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html}, +@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html}, +and +@uref{https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html}. @cindex port, connecting @cindex 6667, default IRC port @@ -205,13 +214,13 @@ in use, you might for example get assigned the nick @code{alex`}. A space separated list of channels you want to join when connecting. You don't need to join any channels, if you just want to have one-to-one conversations with friends on the same network. If you're new to the -Freenode network, join @code{#emacs}, the channel about all things +Libera.Chat network, join @code{#emacs}, the channel about all things Emacs, or join @code{#rcirc}, the channel about @code{rcirc}. @end table @cindex server buffer When you have answered these questions, @code{rcirc} will create a server -buffer, which will be named something like @file{*irc.freenode.net*}, +buffer, which will be named something like @file{*irc.libera.chat*}, and a channel buffer for each of the channels you wanted to join. @kindex RET @@ -482,7 +491,7 @@ Here's an example of how to set it: @end example By default you will be connected to the @code{rcirc} support channel: -@code{#rcirc} on @code{irc.freenode.net}. +@code{#rcirc} on @code{irc.libera.chat}. @table @code @item :nick @@ -554,8 +563,8 @@ Here is an example to illustrate how you would set it: @example (setq rcirc-authinfo - '(("freenode" nickserv "bob" "p455w0rd") - ("freenode" chanserv "bob" "#bobland" "passwd99") + '(("Libera.Chat" nickserv "bob" "p455w0rd") + ("Libera.Chat" chanserv "bob" "#bobland" "passwd99") ("bitlbee" bitlbee "robert" "sekrit"))) @end example diff --git a/etc/NEWS b/etc/NEWS index 1959bb8f32..564a7ce7a7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -30,6 +30,29 @@ applies, and please also update docstrings as needed. * Changes in Emacs 27.3 ++++ +** Update IRC-related references to point to Libera.Chat. +In June 2021, the Free Software Foundation and the GNU Project moved +their official IRC channels from the Freenode network to Libera.Chat +in the aftermath of the changes in Freenode's governance structure and +policies in May and June 2021. The decision-making process took into +account the feedback received from the community against a set of +criteria devised by a working group drawn from both GNU and the FSF +to gauge a chat network's acceptability to software freedom activists. + +For the original announcement and the follow-up update, including more +details, see: + +https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html +https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html + +Given the relocation of GNU and FSF's official IRC channels, as well +as #emacs and various other Emacs-themed channels (see the link below) +to Libera.Chat, IRC-related references in the Emacs repository have +now been updated to point to Libera.Chat. + +https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html + * Editing Changes in Emacs 27.3 diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index dcda9044a5..2c2f62e76e 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1793,7 +1793,7 @@ See `erc-display-server-message'." nil 's324 ?c channel ?m modes))) (define-erc-response-handler (328) - "Channel URL (on freenode network)." nil + "Channel URL." nil (let ((channel (cadr (erc-response.command-args parsed))) (url (erc-response.contents parsed))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 4a566096cb..ac32b294d3 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -290,6 +290,13 @@ ("LagNet: Random server" LagNet "irc.lagnet.org.za" 6667) ("LagNet: AF, ZA, Cape Town" LagNet "reaper.lagnet.org.za" 6667) ("LagNet: AF, ZA, Johannesburg" LagNet "mystery.lagnet.org.za" 6667) + ("Libera.Chat: Random server" Libera.Chat "irc.libera.chat" 6667) + ("Libera.Chat: Random Europe server" Libera.Chat "irc.eu.libera.chat" 6667) + ("Libera.Chat: Random US & Canada server" Libera.Chat "irc.us.libera.chat" 6667) + ("Libera.Chat: Random Australia & New Zealand server" Libera.Chat "irc.au.libera.chat" 6667) + ("Libera.Chat: Random East Asia server" Libera.Chat "irc.ea.libera.chat" 6667) + ("Libera.Chat: IPv4 only server" Libera.Chat "irc.ipv4.libera.chat" 6667) + ("Libera.Chat: IPv6 only server" Libera.Chat "irc.ipv6.libera.chat" 6667) ("Librenet: Random server" Librenet "irc.librenet.net" 6667) ("LinkNet: Random server" LinkNet "irc.link-net.org" ((6667 6669))) ("LinuxChix: Random server" LinuxChix "irc.linuxchix.org" 6667) @@ -595,6 +602,7 @@ PORTS is either a number, a list of numbers, or a list of port ranges." (Krono "krono.net") (Krushnet "krushnet.org") (LagNet "lagnet.org.za") + (Libera.Chat "libera.chat") (Librenet "librenet.net") (LinkNet "link-net.org") (LinuxChix "cats\\.meow\\.at\\|linuxchix\\.org") @@ -836,8 +844,8 @@ As an example: ;; think it is worth the effort. (defvar erc-settings - '((pals freenode ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)")) - (format-nick-function (freenode "#emacs") erc-format-@nick)) + '((pals Libera.Chat ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)")) + (format-nick-function (Libera.Chat "#emacs") erc-format-@nick)) "Experimental: Alist of configuration options. The format is (VARNAME SCOPE VALUE) where VARNAME is a symbol identifying the configuration option, @@ -866,7 +874,7 @@ VALUE is the options value.") items nil))))) val)) -(erc-get 'pals 'freenode) +(erc-get 'pals 'Libera.Chat) (provide 'erc-networks) diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 4f9b0b199f..f04da183c6 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -30,10 +30,10 @@ ;; are made to test if NickServ is the real NickServ for a given network or ;; server. -;; As a default, ERC has the data for the official nickname services on -;; the networks Austnet, BrasNET, Dalnet, freenode, GalaxyNet, GRnet, -;; and Slashnet. You can add more by using M-x customize-variable RET -;; erc-nickserv-alist. +;; As a default, ERC has the data for the official nickname services +;; on the networks Austnet, BrasNET, Dalnet, freenode, GalaxyNet, +;; GRnet, Libera.Chat, and Slashnet. You can add more by using +;; M-x customize-variable RET erc-nickserv-alist. ;; Usage: ;; @@ -43,9 +43,10 @@ ;; (erc-services-mode 1) ;; ;; Add your nickname and NickServ password to `erc-nickserv-passwords'. -;; Using the freenode network as an example: +;; Using the Libera.Chat network as an example: ;; -;; (setq erc-nickserv-passwords '((freenode (("nickname" "password"))))) +;; (setq erc-nickserv-passwords +;; '((Libera.Chat (("nickname" "password"))))) ;; ;; The default automatic identification mode is autodetection of NickServ ;; identify requests. Set the variable `erc-nickserv-identify-mode' if @@ -173,8 +174,8 @@ You can also use \\[erc-nickserv-identify-mode] to change modes." Example of use: (setq erc-nickserv-passwords - \\='((freenode ((\"nick-one\" . \"password\") - (\"nick-two\" . \"password\"))) + \\='((Libera.Chat ((\"nick-one\" . \"password\") + (\"nick-two\" . \"password\"))) (DALnet ((\"nick\" . \"password\")))))" :group 'erc-services :type '(repeat @@ -190,6 +191,7 @@ Example of use: (const GalaxyNet) (const GRnet) (const iip) + (const Libera.Chat) (const OFTC) (const QuakeNet) (const Rizon) @@ -257,6 +259,15 @@ Example of use: "type\\s-/squery\\s-Trent\\s-identify\\s-" "Trent@anon.iip" "IDENTIFY" nil "SQUERY" nil) + (Libera.Chat + "NickServ!NickServ@services.libera.chat" + ;; Libera.Chat also accepts a password at login, see the `erc' + ;; :password argument. + "This\\s-nickname\\s-is\\s-registered.\\s-Please\\s-choose" + "NickServ" + "IDENTIFY" nil nil + ;; See also the 901 response code message. + "You\\s-are\\s-now\\s-identified\\s-for\\s-") (OFTC "NickServ!services@services.oftc.net" ;; OFTC's NickServ doesn't ask you to identify anymore. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 1e055a6c52..2bd58ba937 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -255,7 +255,7 @@ A typical value would be \(\"JOIN\" \"PART\" \"QUIT\")." (defcustom erc-network-hide-list nil "A list of IRC networks to hide message types from. -A typical value would be \((\"freenode\" \"MODE\") +A typical value would be \((\"Libera.Chat\" \"MODE\") \(\"OFTC\" \"JOIN\" \"QUIT\"))." :version "25.1" :group 'erc-ignore @@ -1499,7 +1499,7 @@ Defaults to the server buffer." ;; activation -(defconst erc-default-server "irc.freenode.net" +(defconst erc-default-server "irc.libera.chat" "IRC server to use if it cannot be detected otherwise.") (defconst erc-default-port 6667 @@ -2229,7 +2229,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\") + (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") then the server and full-name will be set to those values, whereas `erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will @@ -3355,8 +3355,9 @@ to send. If only one word is given, display the mode of that target. -A list of valid mode strings for Freenode may be found at -URL `http://freenode.net/using_the_network.shtml'." +A list of valid mode strings for Libera.Chat may be found at +`https://libera.chat/guides/channelmodes' and +`https://libera.chat/guides/usermodes'." (cond ((string-match "^\\s-\\(.*\\)$" line) (let ((s (match-string 1 line))) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index b0ab27bc4c..71b107e071 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -10679,7 +10679,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\") + (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") then the server and full-name will be set to those values, whereas `erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 02965881ea..d4472572d6 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -56,9 +56,9 @@ :group 'applications) (defcustom rcirc-server-alist - '(("irc.freenode.net" :channels ("#rcirc") + '(("irc.libera.chat" :channels ("#rcirc") ;; Don't use the TLS port by default, in case gnutls is not available. - ;; :port 7000 :encryption tls + ;; :port 6697 :encryption tls )) "An alist of IRC connections to establish when running `rcirc'. Each element looks like (SERVER-NAME PARAMETERS). @@ -249,8 +249,8 @@ The ARGUMENTS for each METHOD symbol are: `quakenet': ACCOUNT PASSWORD Examples: - ((\"freenode\" nickserv \"bob\" \"p455w0rd\") - (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\") + ((\"Libera.Chat\" nickserv \"bob\" \"p455w0rd\") + (\"Libera.Chat\" chanserv \"bob\" \"#bobland\" \"passwd99\") (\"bitlbee\" bitlbee \"robert\" \"sekrit\") (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\") (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))" diff --git a/lisp/org/ol-irc.el b/lisp/org/ol-irc.el index e3d7651c1a..df62dd0625 100644 --- a/lisp/org/ol-irc.el +++ b/lisp/org/ol-irc.el @@ -39,9 +39,9 @@ ;; ;; Links within an org buffer might look like this: ;; -;; [[irc:/irc.freenode.net/#emacs/bob][chat with bob in #emacs on freenode]] -;; [[irc:/irc.freenode.net/#emacs][#emacs on freenode]] -;; [[irc:/irc.freenode.net/]] +;; [[irc:/irc.libera.chat/#emacs/bob][chat with bob in #emacs on Libera.Chat]] +;; [[irc:/irc.libera.chat/#emacs][#emacs on Libera.Chat]] +;; [[irc:/irc.libera.chat/]] ;; ;; If, when the resulting link is visited, there is no connection to a ;; requested server then one will be created. commit 9b318d5c58fef6faf344f0377cbf169b5e1f0e09 Author: Dmitry Gutov Date: Sun Jul 4 04:38:35 2021 +0300 Speed up fido-mode * lisp/icomplete.el (icomplete-completions): Speed up fido-mode (bug#48841). diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 26698c43cf..576fced015 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -859,13 +859,16 @@ matches exist." (base-size (prog1 (cdr last) (if last (setcdr last nil)))) (most-try - (if (and base-size (> base-size 0)) + ;; icomplete-hide-common-prefix logic is used + ;; unconditionally when there is single match. + (when (or icomplete-hide-common-prefix (not (cdr comps))) + (if (and base-size (> base-size 0)) + (completion-try-completion + name candidates predicate (length name) md) + ;; If the `comps' are 0-based, the result should be + ;; the same with `comps'. (completion-try-completion - name candidates predicate (length name) md) - ;; If the `comps' are 0-based, the result should be - ;; the same with `comps'. - (completion-try-completion - name comps nil (length name) md))) + name comps nil (length name) md)))) (most (if (consp most-try) (car most-try) (if most-try (car comps) ""))) ;; Compare name and most, so we can determine if name is commit b0e725e2fee2b6713eb724ef9812d6534750054d Author: Daniel Martín Date: Sat Jul 3 17:59:22 2021 +0200 Fix typo in c-macro-expand docstring * lisp/progmodes/cmacexp.el (c-macro-expand): Fix typo. (Bug#49356) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index d3a33bdf87..a393ca9be8 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -155,7 +155,7 @@ Normally display output in temp buffer, but prefix arg means replace the region with it. `c-macro-preprocessor' specifies the preprocessor to use. -Tf the user option `c-macro-prompt-flag' is non-nil +If the user option `c-macro-prompt-flag' is non-nil prompt for arguments to the preprocessor \(e.g. `-DDEBUG -I ./include'), otherwise use `c-macro-cppflags'. commit 0aee54a54beebedee20466b23ab99ae48f61259c Author: Christopher League Date: Sat Jul 3 10:46:28 2021 -0300 Retain documentation string when customizing theme * lisp/cus-theme.el (customize-create-theme): When editing an existing theme, load its doc string into the description widget, instead of replacing it with a date stamp (Bug#49274). diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index dfa2226403..f4885d0f52 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -108,60 +108,16 @@ named *Custom Theme*." (unless (y-or-n-p "Include basic face customizations in this theme? ") (setq custom-theme--listed-faces nil))) - (if (eq theme 'user) - (widget-insert "This buffer contains all the Custom settings you have made. -You can convert them into a new custom theme, and optionally -remove them from your saved Custom file.\n\n")) - - (widget-create 'push-button - :tag " Visit Theme " - :help-echo "Insert the settings of a pre-defined theme." - :action (lambda (_widget &optional _event) - (call-interactively #'custom-theme-visit-theme))) - (widget-insert " ") - (widget-create 'push-button - :tag " Merge Theme " - :help-echo "Merge in the settings of a pre-defined theme." - :action (lambda (_widget &optional _event) - (call-interactively #'custom-theme-merge-theme))) - (widget-insert " ") - (widget-create 'push-button - :tag " Revert " - :help-echo "Revert this buffer to its original state." - :action (lambda (&rest ignored) (revert-buffer))) - - (widget-insert "\n\nTheme name : ") - (setq custom-theme-name - (widget-create 'editable-field - :value (if (and theme (not (eq theme 'user))) - (symbol-name theme) - ""))) - (widget-insert "Description: ") - (setq custom-theme-description - (widget-create 'text - :value (format-time-string "Created %Y-%m-%d."))) - (widget-create 'push-button - :notify #'custom-theme-write - " Save Theme ") - (when (eq theme 'user) - (setq custom-theme--migrate-settings t) - (widget-insert " ") - (widget-create 'checkbox - :value custom-theme--migrate-settings - :action (lambda (widget &optional event) - (when (widget-value widget) - (widget-toggle-action widget event) - (setq custom-theme--migrate-settings - (widget-value widget))))) - (widget-insert (propertize " Remove saved theme settings from Custom save file." - 'face '(variable-pitch (:height 0.9))))) - (let (vars values faces face-specs) ;; Load the theme settings. (when theme - (unless (eq theme 'user) - (load-theme theme nil t)) + (if (eq theme 'user) + (widget-insert "This buffer contains all the Custom settings you have made. +You can convert them into a new custom theme, and optionally +remove them from your saved Custom file.\n\n") + (load-theme theme nil t)) + (dolist (setting (get theme 'theme-settings)) (if (eq (car setting) 'theme-value) (progn (push (nth 1 setting) vars) @@ -169,6 +125,50 @@ remove them from your saved Custom file.\n\n")) (push (nth 1 setting) faces) (push (nth 3 setting) face-specs)))) + (widget-create 'push-button + :tag " Visit Theme " + :help-echo "Insert the settings of a pre-defined theme." + :action (lambda (_widget &optional _event) + (call-interactively #'custom-theme-visit-theme))) + (widget-insert " ") + (widget-create 'push-button + :tag " Merge Theme " + :help-echo "Merge in the settings of a pre-defined theme." + :action (lambda (_widget &optional _event) + (call-interactively #'custom-theme-merge-theme))) + (widget-insert " ") + (widget-create 'push-button + :tag " Revert " + :help-echo "Revert this buffer to its original state." + :action (lambda (&rest ignored) (revert-buffer))) + + (widget-insert "\n\nTheme name : ") + (setq custom-theme-name + (widget-create 'editable-field + :value (if (and theme (not (eq theme 'user))) + (symbol-name theme) + ""))) + (widget-insert "Description: ") + (setq custom-theme-description + (widget-create 'text :format "%v" + :value (or (get theme 'theme-documentation) + (format-time-string "Created %Y-%m-%d.")))) + (widget-create 'push-button + :notify #'custom-theme-write + " Save Theme ") + (when (eq theme 'user) + (setq custom-theme--migrate-settings t) + (widget-insert " ") + (widget-create 'checkbox + :value custom-theme--migrate-settings + :action (lambda (widget &optional event) + (when (widget-value widget) + (widget-toggle-action widget event) + (setq custom-theme--migrate-settings + (widget-value widget))))) + (widget-insert (propertize " Remove saved theme settings from Custom save file." + 'face '(variable-pitch (:height 0.9))))) + ;; If THEME is non-nil, insert all of that theme's faces. ;; Otherwise, insert those in `custom-theme--listed-faces'. (widget-insert "\n\n Theme faces:\n ") commit f222fe6163c63966c9f0128dd5ea6b06ff428628 Author: Philip Kaludercic Date: Fri Jul 2 20:11:08 2021 +0200 * rcirc.el (rcirc-define-command): Mention name of malformed command Author: diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 154413871c..4f8d9612c6 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2455,7 +2455,7 @@ that, an interactive form can specified." (unless (if (listp ,argument) (not (<= ,required (length ,argument) ,total)) (string-match ,regexp ,argument)) - (user-error "Malformed input: %S" ',arguments)) + (user-error "Malformed input (%s): %S" ,command ',arguments)) (let ((process (or process (rcirc-buffer-process))) (target (or target rcirc-target))) (ignore target process) commit 5bd04ea307f1dfc5002715a23b8bea1c038f65a6 Author: Lars Ingebrigtsen Date: Fri Jul 2 17:29:10 2021 +0200 Don't have desktop-save-mode query on `M-x kill-emacs' * lisp/desktop.el (noninteractive): Prompting functions should not be added to `kill-emacs-hook' (bug#28943). (desktop-kill): Return t so that it can be used from `kill-emacs-query-functions'. diff --git a/lisp/desktop.el b/lisp/desktop.el index fb7c6c79a1..ae8d026acc 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -731,7 +731,7 @@ if different)." ;; ---------------------------------------------------------------------------- (unless noninteractive - (add-hook 'kill-emacs-hook #'desktop-kill)) + (add-hook 'kill-emacs-query-functions #'desktop-kill)) (defun desktop-kill () "If `desktop-save-mode' is non-nil, do what `desktop-save' says to do. @@ -759,7 +759,8 @@ is nil, ask the user where to save the desktop." (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") (signal (car err) (cdr err)))))) ;; If we own it, we don't anymore. - (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock))) + (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)) + t) ;; ---------------------------------------------------------------------------- (defun desktop-list* (&rest args) commit 225ca617b70d3c70376c2d9bf38ced2f2323b26e Author: Michael Albinus Date: Fri Jul 2 14:51:23 2021 +0200 Implement another fix for bug#49229 * lisp/minibuffer.el (read-file-name-default): Respect remote files. (Bug#49229) * lisp/net/tramp-sh.el (tramp-sh-handle-expand-file-name): Handle special file names on MS Windows. * lisp/net/tramp.el (tramp-file-name-handler): Revert patch. (Bug#49229) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 71a2177c9b..813ce14c59 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3161,6 +3161,7 @@ See `read-file-name' for the meaning of the arguments." (unless val (error "No file name specified")) (if (and default-filename + (not (file-remote-p dir)) (string-equal val (if (consp insdef) (car insdef) insdef))) (setq val default-filename)) (setq val (substitute-in-file-name val)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ebd0fbfd2d..88caa2fb7b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2667,56 +2667,63 @@ the result will be a local, non-Tramp, file name." (setq dir (or dir default-directory "/")) ;; Handle empty NAME. (when (zerop (length name)) (setq name ".")) - ;; Unless NAME is absolute, concat DIR and NAME. - (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) - ;; If connection is not established yet, run the real handler. - (if (not (tramp-connectable-p name)) - (tramp-run-real-handler #'expand-file-name (list name nil)) - ;; Dissect NAME. - (with-parsed-tramp-file-name name nil - (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) - (setq localname (concat "~/" localname))) - ;; Tilde expansion if necessary. This needs a shell which - ;; groks tilde expansion! The function `tramp-find-shell' is - ;; supposed to find such a shell on the remote host. Please - ;; tell me about it when this doesn't work on your system. - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) - (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) - ;; We cannot simply apply "~/", because under sudo "~/" is - ;; expanded to the local user home directory but to the - ;; root home directory. On the other hand, using always - ;; the default user name for tilde expansion is not - ;; appropriate either, because ssh and companions might - ;; use a user name from the config file. - (when (and (string-equal uname "~") - (string-match-p "\\`su\\(do\\)?\\'" method)) - (setq uname (concat uname user))) - (setq uname - (with-tramp-connection-property v uname - (tramp-send-command - v (format "cd %s && pwd" (tramp-shell-quote-argument uname))) - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-min)) - (buffer-substring (point) (point-at-eol))))) - (setq localname (concat uname fname)))) - ;; There might be a double slash, for example when "~/" - ;; expands to "/". Remove this. - (while (string-match "//" localname) - (setq localname (replace-match "/" t t localname))) - ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) - (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). - ;; `default-directory' is bound, because on Windows there would - ;; be problems with UNC shares or Cygwin mounts. - (let ((default-directory (tramp-compat-temporary-file-directory))) - (tramp-make-tramp-file-name - v (tramp-drop-volume-letter - (tramp-run-real-handler - #'expand-file-name (list localname)))))))) + ;; On MS Windows, some special file names are not returned properly + ;; by `file-name-absolute-p'. + (if (and (eq system-type 'windows-nt) + (string-match-p + (concat "^\\([[:alpha:]]:\\|" null-device "$\\)") name)) + (tramp-run-real-handler #'expand-file-name (list name dir)) + ;; Unless NAME is absolute, concat DIR and NAME. + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory dir) name))) + ;; If connection is not established yet, run the real handler. + (if (not (tramp-connectable-p name)) + (tramp-run-real-handler #'expand-file-name (list name nil)) + ;; Dissect NAME. + (with-parsed-tramp-file-name name nil + (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) + (setq localname (concat "~/" localname))) + ;; Tilde expansion if necessary. This needs a shell which + ;; groks tilde expansion! The function `tramp-find-shell' is + ;; supposed to find such a shell on the remote host. Please + ;; tell me about it when this doesn't work on your system. + (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname))) + ;; We cannot simply apply "~/", because under sudo "~/" is + ;; expanded to the local user home directory but to the + ;; root home directory. On the other hand, using always + ;; the default user name for tilde expansion is not + ;; appropriate either, because ssh and companions might + ;; use a user name from the config file. + (when (and (string-equal uname "~") + (string-match-p "\\`su\\(do\\)?\\'" method)) + (setq uname (concat uname user))) + (setq uname + (with-tramp-connection-property v uname + (tramp-send-command + v + (format "cd %s && pwd" (tramp-shell-quote-argument uname))) + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-min)) + (buffer-substring (point) (point-at-eol))))) + (setq localname (concat uname fname)))) + ;; There might be a double slash, for example when "~/" + ;; expands to "/". Remove this. + (while (string-match "//" localname) + (setq localname (replace-match "/" t t localname))) + ;; Do not keep "/..". + (when (string-match-p "^/\\.\\.?$" localname) + (setq localname "/")) + ;; No tilde characters in file name, do normal + ;; `expand-file-name' (this does "/./" and "/../"). + ;; `default-directory' is bound, because on Windows there + ;; would be problems with UNC shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) + (tramp-make-tramp-file-name + v (tramp-drop-volume-letter + (tramp-run-real-handler + #'expand-file-name (list localname))))))))) ;;; Remote commands: diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ee7e0cf2c3..75e44551ef 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2610,14 +2610,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." ;; When `tramp-mode' is not enabled, or the file name is quoted, ;; we don't do anything. - ;; When operation is `expand-file-name', and the first argument - ;; is a local absolute file name, we end also here. Handle the - ;; MS Windows case. - (funcall - (if (and (eq operation 'expand-file-name) - (not (string-match-p "\\`[[:alpha:]]:/" (car args)))) - #'tramp-drop-volume-letter #'identity) - (tramp-run-real-handler operation args))))) + (tramp-run-real-handler operation args)))) (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler for OPERATION and ARGS. commit 38aa2074f84b4aec5ccc3a9b250c0dcee18157f8 Author: Peter Oliver Date: Wed Jun 9 12:58:39 2021 +0100 Hide emacs-mail.desktop, emacsclient-mail.desktop from menus These are intended for use as mailto: URL handlers, not for launching directly, so we can reduce clutter by hiding them from a desktop environment’s menus. * etc/emacs-mail.desktop, etc/emacsclient-mail.desktop: NoDisplay=true diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop index 3a96b9ec8c..3468033584 100644 --- a/etc/emacs-mail.desktop +++ b/etc/emacs-mail.desktop @@ -5,6 +5,6 @@ Exec=emacs -f message-mailto %u Icon=emacs Name=Emacs (Mail) MimeType=x-scheme-handler/mailto; -NoDisplay=false +NoDisplay=true Terminal=false Type=Application diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop index 4df79ed300..8d51dcdd2f 100644 --- a/etc/emacsclient-mail.desktop +++ b/etc/emacsclient-mail.desktop @@ -5,7 +5,7 @@ Exec=sh -c 'exec emacsclient --alternate-editor= --display="$DISPLAY" --eval "(m Icon=emacs Name=Emacs (Mail, Client) MimeType=x-scheme-handler/mailto; -NoDisplay=false +NoDisplay=true Terminal=false Type=Application Actions=new-window;new-instance; commit 2aedf1c85c2108f89b3f0dfb5146cea911174747 Author: Peter Oliver Date: Wed Jun 9 12:51:15 2021 +0100 Install emacs-mail.desktop and emacsclient-mail.desktop * Makefile.in (install-etc): Install emacs-mail.desktop and emacsclient-mail.desktop diff --git a/Makefile.in b/Makefile.in index 8c14c5cc7d..97d954b6ce 100644 --- a/Makefile.in +++ b/Makefile.in @@ -742,6 +742,19 @@ install-etc: ${srcdir}/etc/emacsclient.desktop > $${tmp}; \ ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/$${client_name}.desktop"; \ rm -f $${tmp} + tmp=etc/emacs-mail.tmpdesktop; rm -f $${tmp}; \ + sed -e "/^Exec=emacs/ s/emacs/${EMACS_NAME}/" \ + -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \ + ${srcdir}/etc/emacs-mail.desktop > $${tmp}; \ + ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/${EMACS_NAME}-mail.desktop"; \ + rm -f $${tmp} + tmp=etc/emacsclient-mail.tmpdesktop; rm -f $${tmp}; \ + client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \ + sed -e "/^Exec=emacsclient/ s|emacsclient|${bindir}/$${client_name}|" \ + -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \ + ${srcdir}/etc/emacsclient-mail.desktop > $${tmp}; \ + ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/$${client_name}-mail.desktop"; \ + rm -f $${tmp} umask 022; ${MKDIR_P} "$(DESTDIR)${metainfodir}" tmp=etc/emacs.tmpmetainfo; rm -f $${tmp}; \ sed -e "s/emacs\.desktop/${EMACS_NAME}.desktop/" \ commit b1b05c828d67930bb3b897fe98e1992db42cf23c Author: Peter Oliver Date: Wed Jun 9 12:44:32 2021 +0100 Provide an emacsclient-mail.desktop We provide both an emacs.desktop and an emacsclient.desktop, so for consistency let’s do the same with mail. * etc/emacs-mail.desktop: Extract suggestions for using emacsclient from comments to create emacsclient-mail.desktop. * etc/emacsclient-mail.desktop: Send mail using an existing Emacs rather than starting a new one. diff --git a/etc/NEWS b/etc/NEWS index 5b04278e3a..1a3130826a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1077,6 +1077,7 @@ Clicking on a 'mailto:' link in other applications will then open Emacs with headers filled out according to the link, e.g. "mailto:larsi@gnus.org?subject=This+is+a+test". If you prefer emacsclient, use "emacsclient -e '(message-mailto "%u")'" +or "emacsclient-mail.desktop". --- *** Change to default value of 'message-draft-headers' user option. diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop index 251afa100c..3a96b9ec8c 100644 --- a/etc/emacs-mail.desktop +++ b/etc/emacs-mail.desktop @@ -1,22 +1,10 @@ [Desktop Entry] Categories=Network;Email; Comment=GNU Emacs is an extensible, customizable text editor - and more +Exec=emacs -f message-mailto %u Icon=emacs Name=Emacs (Mail) MimeType=x-scheme-handler/mailto; NoDisplay=false Terminal=false Type=Application - -Exec=emacs -f message-mailto %u -# # If you prefer to use emacsclient, use this instead: -# Exec=sh -c 'emacsclient --alternate-editor= --display="$DISPLAY" --eval "(message-mailto \"%u\")"' -# Actions=new-window;new-instance; - -# [Desktop Action new-window] -# Name=New Window -# Exec=emacsclient --alternate-editor= --create-frame --eval '(message-mailto "%u")' - -# [Desktop Action new-instance] -# Name=New Instance -# Exec=emacs -f message-mailto %u diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop new file mode 100644 index 0000000000..4df79ed300 --- /dev/null +++ b/etc/emacsclient-mail.desktop @@ -0,0 +1,19 @@ +[Desktop Entry] +Categories=Network;Email; +Comment=GNU Emacs is an extensible, customizable text editor - and more +Exec=sh -c 'exec emacsclient --alternate-editor= --display="$DISPLAY" --eval "(message-mailto \"%u\")"' +Icon=emacs +Name=Emacs (Mail, Client) +MimeType=x-scheme-handler/mailto; +NoDisplay=false +Terminal=false +Type=Application +Actions=new-window;new-instance; + +[Desktop Action new-window] +Name=New Window +Exec=emacsclient --alternate-editor= --create-frame --eval '(message-mailto "%u")' + +[Desktop Action new-instance] +Name=New Instance +Exec=emacs -f message-mailto %u commit 9eadcfdfe6f7b26ba44360db9f828fdbe7a78fe7 Author: Tino Calancha Date: Sun Jun 27 17:53:30 2021 +0200 lisp/auth-source-pass.el: Keep legitimate spaces inside data Users should be able to store a field as follows: message: remember: Destroy the image and you will break the enemy and later, recover the message untouched, i.e.: "remember: Destroy the image and you will break the enemy" * lisp/auth-source-pass.el (auth-source-pass--parse-data): Preserve inner spaces at data. * test/lisp/auth-source-pass-tests.el (auth-source-pass-parse-with-colons-in-data): Add test. diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index c512c6fe4f..914f8d2f1b 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -167,15 +167,13 @@ The secret is the first line of CONTENTS." (defun auth-source-pass--parse-data (contents) "Parse the password-store data in the string CONTENTS and return an alist. CONTENTS is the contents of a password-store formatted file." - (let ((lines (split-string contents "\n" t "[ \t]+"))) + (let ((lines (cdr (split-string contents "\n" t "[ \t]+")))) (seq-remove #'null (mapcar (lambda (line) - (let ((pair (mapcar (lambda (s) (string-trim s)) - (split-string line ":")))) - (when (> (length pair) 1) - (cons (car pair) - (mapconcat #'identity (cdr pair) ":"))))) - (cdr lines))))) + (when-let ((pos (seq-position line ?:))) + (cons (string-trim (substring line 0 pos)) + (string-trim (substring line (1+ pos)))))) + lines)))) (defun auth-source-pass--do-debug (&rest msg) "Call `auth-source-do-debug` with MSG and a prefix." diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index a2f84f20e8..d050ac5b69 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -49,6 +49,12 @@ '(("key1" . "val1") ("key2" . "val2")))))) +(ert-deftest auth-source-pass-parse-with-colons-in-data () + (let ((content "pass\n--\nkey1 :val1\nkey2: please: keep my space after colon\n\n")) + (should (equal (auth-source-pass--parse-data content) + '(("key1" . "val1") + ("key2" . "please: keep my space after colon")))))) + (defvar auth-source-pass--debug-log nil "Contains a list of all messages passed to `auth-source-do-debug`.") commit c3322729e4eb04539e2b6b9b06088e131c6a84f0 Author: Damien Cassou Date: Sun Jun 27 17:51:54 2021 +0200 ; * lisp/auth-source-pass.el: Remove useless metadata diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0f8be84dc2..c512c6fe4f 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -6,8 +6,6 @@ ;; Nicolas Petton ;; Keith Amidon ;; Version: 5.0.0 -;; Package-Requires: ((emacs "25")) -;; Url: https://github.com/DamienCassou/auth-password-store ;; Created: 07 Jun 2015 ;; This file is part of GNU Emacs. commit aad2e698077eb5cf658c36c5728c5ee36d598d23 Author: Damien Cassou Date: Sun Jun 27 17:38:59 2021 +0200 ; * lisp/auth-source-pass.el: Improve docstrings diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 6e33970486..0f8be84dc2 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -60,11 +60,10 @@ (cl-defun auth-source-pass-search (&rest spec &key backend type host user port &allow-other-keys) - "Given a property list SPEC, return search matches from the :backend. -See `auth-source-search' for details on SPEC. + "Given some search query, return matching credentials. -HOST can be a string or a list of strings, but USER and PORT are expected -to be a string only." +See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE, +HOST, USER and PORT." (cl-assert (or (null type) (eq type (oref backend type))) t "Invalid password-store search: %s %s") (cond ((eq host t) @@ -126,7 +125,7 @@ ENTRY is the name of a password-store entry. The key used to retrieve the password is the symbol `secret'. The convention used as the format for a password-store file is -the following (see https://www.passwordstore.org/#organization): +the following (see URL `https://www.passwordstore.org/#organization'): secret key1: value1 @@ -278,7 +277,7 @@ If ENTRIES is nil, use the result of calling `auth-source-pass-entries' instead. (defun auth-source-pass--generate-entry-suffixes (hostname user port) "Return a list of possible entry path suffixes in the password-store. -Based on the supported pathname patterns for HOSTNAME, USER, & +Based on the supported filename patterns for HOSTNAME, USER, & PORT, return a list of possible suffixes for matching entries in the password-store. @@ -326,3 +325,5 @@ then NAME & USER, then NAME & PORT, then just NAME." (provide 'auth-source-pass) ;;; auth-source-pass.el ends here + +;; LocalWords: backend hostname commit b09ee1406205e8b6298411b9a18c1cd26e201689 Author: Iku Iwasa Date: Sun Jun 27 17:36:00 2021 +0200 lisp/auth-source-pass.el: Support multiple hosts in search spec * lisp/auth-source-pass.el (auth-source-pass-search): Accept a list of strings for argument HOST. (auth-source-pass--build-result): Rename argument HOST to HOSTS. Also return value "host" from entry if it exists. (auth-source-pass--find-match): Rename argument HOST to HOSTS. Iterate over each host in HOSTS. * test/lisp/auth-source-pass-tests.el: Add corresponding tests diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index a7b959c47f..6e33970486 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -61,13 +61,12 @@ &key backend type host user port &allow-other-keys) "Given a property list SPEC, return search matches from the :backend. -See `auth-source-search' for details on SPEC." +See `auth-source-search' for details on SPEC. + +HOST can be a string or a list of strings, but USER and PORT are expected +to be a string only." (cl-assert (or (null type) (eq type (oref backend type))) t "Invalid password-store search: %s %s") - (when (consp host) - (warn "auth-source-pass ignores all but first host in spec.") - ;; Take the first non-nil item of the list of hosts - (setq host (seq-find #'identity host))) (cond ((eq host t) (warn "auth-source-pass does not handle host wildcards.") nil) @@ -78,12 +77,14 @@ See `auth-source-search' for details on SPEC." (when-let ((result (auth-source-pass--build-result host port user))) (list result))))) -(defun auth-source-pass--build-result (host port user) - "Build auth-source-pass entry matching HOST, PORT and USER." - (let ((entry-data (auth-source-pass--find-match host user port))) +(defun auth-source-pass--build-result (hosts port user) + "Build auth-source-pass entry matching HOSTS, PORT and USER. + +HOSTS can be a string or a list of strings." + (let ((entry-data (auth-source-pass--find-match hosts user port))) (when entry-data (let ((retval (list - :host host + :host (auth-source-pass--get-attr "host" entry-data) :port (or (auth-source-pass--get-attr "port" entry-data) port) :user (or (auth-source-pass--get-attr "user" entry-data) user) :secret (lambda () (auth-source-pass--get-attr 'secret entry-data))))) @@ -194,12 +195,21 @@ CONTENTS is the contents of a password-store formatted file." (lambda (file) (file-name-sans-extension (file-relative-name file store-dir))) (directory-files-recursively store-dir "\\.gpg\\'")))) -(defun auth-source-pass--find-match (host user port) - "Return password-store entry data matching HOST, USER and PORT. - -Disambiguate between user provided inside HOST (e.g., user@server.com) and -inside USER by giving priority to USER. Same for PORT." - (apply #'auth-source-pass--find-match-unambiguous (auth-source-pass--disambiguate host user port))) +(defun auth-source-pass--find-match (hosts user port) + "Return password-store entry data matching HOSTS, USER and PORT. + +Disambiguate between user provided inside HOSTS (e.g., user@server.com) and +inside USER by giving priority to USER. Same for PORT. +HOSTS can be a string or a list of strings." + (seq-some (lambda (host) + (let ((entry (apply #'auth-source-pass--find-match-unambiguous + (auth-source-pass--disambiguate host user port)))) + (if (or (null entry) (assoc "host" entry)) + entry + (cons (cons "host" host) entry)))) + (if (listp hosts) + hosts + (list hosts)))) (defun auth-source-pass--disambiguate (host &optional user port) "Return (HOST USER PORT) after disambiguation. diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index bfbef53db9..a2f84f20e8 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -424,21 +424,37 @@ HOSTNAME, USER and PORT are passed unchanged to (auth-source-pass--with-store-find-foo '(("foo" ("secret" . "foo password"))) (let ((result (auth-source-pass--build-result "foo" 512 "user"))) + (should (equal (plist-get result :host) "foo")) (should (equal (plist-get result :port) 512)) (should (equal (plist-get result :user) "user"))))) (ert-deftest auth-source-pass-build-result-return-entry-values () (auth-source-pass--with-store-find-foo '(("foo" ("port" . 512) ("user" . "anuser"))) (let ((result (auth-source-pass--build-result "foo" nil nil))) + (should (equal (plist-get result :host) "foo")) (should (equal (plist-get result :port) 512)) (should (equal (plist-get result :user) "anuser"))))) (ert-deftest auth-source-pass-build-result-entry-takes-precedence () - (auth-source-pass--with-store-find-foo '(("foo" ("port" . 512) ("user" . "anuser"))) + (auth-source-pass--with-store-find-foo '(("foo" ("host" . "bar") ("port" . 512) ("user" . "anuser"))) (let ((result (auth-source-pass--build-result "foo" 1024 "anotheruser"))) + (should (equal (plist-get result :host) "bar")) (should (equal (plist-get result :port) 512)) (should (equal (plist-get result :user) "anuser"))))) +(ert-deftest auth-source-pass-build-result-with-multiple-hosts () + (auth-source-pass--with-store-find-foo + '(("foo" ("secret" . "foo password"))) + (let ((result (auth-source-pass--build-result '("bar" "foo") 512 "user"))) + (should (equal (plist-get result :host) "foo")) + (should (equal (plist-get result :port) 512)) + (should (equal (plist-get result :user) "user"))))) + +(ert-deftest auth-source-pass-build-result-with-multiple-hosts-no-match () + (auth-source-pass--with-store-find-foo + '(("foo" ("secret" . "foo password"))) + (should-not (auth-source-pass--build-result '("bar" "baz") 512 "user")))) + (ert-deftest auth-source-pass-can-start-from-auth-source-search () (auth-source-pass--with-store '(("gitlab.com" ("user" . "someone"))) (auth-source-pass-enable) commit bb455d0daad89f5d895232f66c26a7fee6bb9bc8 Author: Jim Porter Date: Thu Jul 1 13:01:00 2021 +0200 Don't pass 'null-device' to 'call-process' in ispell * lisp/textmodes/ispell.el (ispell-find-hunspell-dictionaries): Replace 'null-device' with nil (bug#49283). This allows running a local ispell process when editing a buffer editing a file via Tramp. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index ce5a572085..0a82bf5a2d 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1076,7 +1076,7 @@ dictionary from that list was found." (split-string (with-temp-buffer (ispell-call-process ispell-program-name - null-device + nil t nil "-D" commit f449890508e8d52cc2029a34e55bfdb63c431c4b Author: Martin Rudalics Date: Fri Jul 2 10:55:42 2021 +0200 New frame parameter 'drag-with-tab-line' (Bug#49247) The new frame parameter 'drag-with-tab-line' allows to move frames by dragging their topmost windows' tab line with the mouse thus achieving a behavior similar to that provided by the 'drag-with-header-line' parameter. * lisp/mouse.el (mouse-drag-tab-line): New function. (mouse-drag-frame-resize, mouse-drag-frame-move) ([tab-line down-mouse-1]): Handle tab line dragging in various keymaps. * doc/lispref/frames.texi (Mouse Dragging Parameters): Describe new parameter 'drag-with-tab-line'. * etc/NEWS: Add entry for 'drag-with-tab-line'. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a9d20c543d..25706befc8 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2023,8 +2023,8 @@ the @sc{cdr} of the cell is either @code{t} or @code{top-only}. The parameters described below provide support for resizing a frame by dragging its internal borders with the mouse. They also allow moving a -frame with the mouse by dragging the header line of its topmost or the -mode line of its bottommost window. +frame with the mouse by dragging the header or tab line of its topmost +or the mode line of its bottommost window. These parameters are mostly useful for child frames (@pxref{Child Frames}) that come without window manager decorations. If necessary, @@ -2041,6 +2041,11 @@ borders, if present, with the mouse. If non-@code{nil}, the frame can be moved with the mouse by dragging the header line of its topmost window. +@vindex drag-with-tab-line@r{, a frame parameter} +@item drag-with-tab-line +If non-@code{nil}, the frame can be moved with the mouse by dragging the +tab line of its topmost window. + @vindex drag-with-mode-line@r{, a frame parameter} @item drag-with-mode-line If non-@code{nil}, the frame can be moved with the mouse by dragging the diff --git a/etc/NEWS b/etc/NEWS index 605c4d228f..5b04278e3a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -319,6 +319,10 @@ Meta characters to Emacs, e.g., send "ESC x" when the user types emulators by using the new input-meta-mode with the special value 'encoded' with these terminal emulators. ++++ +** New frame parameter 'drag-with-tab-line'. +This parameter, similar to 'drag-with-header-line', allows moving frames +by dragging the tab lines of their topmost windows with the mouse. * Editing Changes in Emacs 28.1 diff --git a/lisp/mouse.el b/lisp/mouse.el index d0064eecfc..ab260d4ed4 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -550,6 +550,18 @@ the frame instead." (when (frame-parameter frame 'drag-with-header-line) (mouse-drag-frame-move start-event)))))) +(defun mouse-drag-tab-line (start-event) + "Drag frame with tab line in its topmost window. +START-EVENT is the starting mouse event of the drag action." + (interactive "e") + (let* ((start (event-start start-event)) + (window (posn-window start))) + (when (and (window-live-p window) + (window-at-side-p window 'top)) + (let ((frame (window-frame window))) + (when (frame-parameter frame 'drag-with-tab-line) + (mouse-drag-frame-move start-event)))))) + (defun mouse-drag-vertical-line (start-event) "Change the width of a window by dragging on a vertical line. START-EVENT is the starting mouse event of the drag action." @@ -678,6 +690,7 @@ frame with the mouse." ;; with a mode-line, header-line or vertical-line prefix ... (define-key map [mode-line] map) (define-key map [header-line] map) + (define-key map [tab-line] map) (define-key map [vertical-line] map) ;; ... and some maybe even with a right- or bottom-divider ;; prefix. @@ -904,6 +917,7 @@ frame with the mouse." ;; with a mode-line, header-line or vertical-line prefix ... (define-key map [mode-line] map) (define-key map [header-line] map) + (define-key map [tab-line] map) (define-key map [vertical-line] map) ;; ... and some maybe even with a right- or bottom-divider ;; prefix. @@ -2908,6 +2922,7 @@ is copied instead of being cut." ;; versions. (global-set-key [header-line down-mouse-1] 'mouse-drag-header-line) (global-set-key [header-line mouse-1] 'mouse-select-window) +(global-set-key [tab-line down-mouse-1] 'mouse-drag-tab-line) (global-set-key [tab-line mouse-1] 'mouse-select-window) ;; (global-set-key [mode-line drag-mouse-1] 'mouse-select-window) (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line) commit aaa32f39420826bdbca30a3bc6212c38c267cda6 Author: Michael Albinus Date: Fri Jul 2 10:01:46 2021 +0200 Fix a problem of cus-start.el for remote default directories * lisp/cus-start.el: Bind `default-directory' to "/" when calling `shell-command-to-string' for a local value on DARWIN. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index b7afef6516..3c2625a8c3 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -285,6 +285,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") ;; See bug#7135. (let* (file-name-handler-alist + (default-directory "/") (tmp (ignore-errors (shell-command-to-string "getconf DARWIN_USER_TEMP_DIR")))) commit 1b88404acc4b6399b617dac2b14f1eaa78135670 Author: Alan Third Date: Wed Jun 30 19:58:13 2021 +0100 Fix NS self contained eln location (bug#49271) * Makefile.in: * configure.ac: Change eln file install location to Contents/Frameworks. * src/comp.c (hash_native_abi): Replace dots with underscores in the eln install location as the macOS code-signing tool won't sign the files if the parent directories have dots. diff --git a/Makefile.in b/Makefile.in index 8fccdf7580..8c14c5cc7d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -333,7 +333,7 @@ BIN_DESTDIR='$(DESTDIR)${bindir}/' ELN_DESTDIR = $(DESTDIR)${libdir}/emacs/${version}/ else BIN_DESTDIR='${ns_appbindir}/' -ELN_DESTDIR = ${ns_applibdir}/emacs/${version}/ +ELN_DESTDIR = ${ns_applibdir}/ endif all: ${SUBDIR} info diff --git a/configure.ac b/configure.ac index 6e2cda947a..c924634d5b 100644 --- a/configure.ac +++ b/configure.ac @@ -1895,7 +1895,7 @@ if test "${with_ns}" != no; then ns_appdir=`pwd`/nextstep/Emacs.app ns_appbindir=${ns_appdir}/Contents/MacOS ns_applibexecdir=${ns_appdir}/Contents/MacOS/libexec - ns_applibdir=${ns_appdir}/Contents/MacOS/lib + ns_applibdir=${ns_appdir}/Contents/Frameworks ns_appresdir=${ns_appdir}/Contents/Resources ns_appsrc=Cocoa/Emacs.base ns_fontfile=macfont.o @@ -1954,7 +1954,7 @@ fail; ns_appdir=`pwd`/nextstep/Emacs.app ns_appbindir=${ns_appdir} ns_applibexecdir=${ns_appdir}/libexec - ns_applibdir=${ns_appdir}/lib + ns_applibdir=${ns_appdir}/Frameworks ns_appresdir=${ns_appdir}/Resources ns_appsrc=GNUstep/Emacs.base ns_fontfile=nsfont.o diff --git a/src/comp.c b/src/comp.c index ea05952627..c380346482 100644 --- a/src/comp.c +++ b/src/comp.c @@ -744,8 +744,34 @@ hash_native_abi (void) Vsystem_configuration_options), Fmapconcat (intern_c_string ("comp--subr-signature"), Vcomp_subr_list, build_string ("")))); + + Lisp_Object version = Vemacs_version; + +#ifdef NS_SELF_CONTAINED + /* MacOS self contained app bundles do not like having dots in the + directory names under the Contents/Frameworks directory, so + convert them to underscores. */ + version = STRING_MULTIBYTE (Vemacs_version) + ? make_uninit_multibyte_string (SCHARS (Vemacs_version), + SBYTES (Vemacs_version)) + : make_uninit_string (SBYTES (Vemacs_version)); + + const unsigned char *from = SDATA (Vemacs_version); + unsigned char *to = SDATA (version); + + while (from < SDATA (Vemacs_version) + SBYTES (Vemacs_version)) + { + unsigned char c = *from++; + + if (c == '.') + c = '_'; + + *to++ = c; + } +#endif + Vcomp_native_version_dir = - concat3 (Vemacs_version, build_string ("-"), Vcomp_abi_hash); + concat3 (version, build_string ("-"), Vcomp_abi_hash); } static void commit 995ab9d0a916e4b1385fe6a25c0a9febe8dbb481 Author: Alan Third Date: Tue Jun 29 22:02:43 2021 +0100 Fix NS native comp search path (bug#49270) * configure.ac (NS_SELF_CONTAINED): We need to make lispdirrel the same as lispdir when building a self contained app bundle as they're both relative paths. diff --git a/configure.ac b/configure.ac index c8920d877e..6e2cda947a 100644 --- a/configure.ac +++ b/configure.ac @@ -2025,6 +2025,7 @@ if test "${HAVE_NS}" = yes; then infodir="\${ns_appresdir}/info" mandir="\${ns_appresdir}/man" lispdir="\${ns_appresdir}/lisp" + lispdirrel="\${ns_appresdir}/lisp" test "$locallisppathset" = no && locallisppath="\${ns_appresdir}/site-lisp" INSTALL_ARCH_INDEP_EXTRA= fi commit 124ba9db96ff7c30963a6c2d44279ed66fc3284d Author: Jonas Bernoulli Date: Thu Jul 1 17:20:58 2021 +0200 * lisp/transient.el: Update to package version 0.3.6. diff --git a/lisp/transient.el b/lisp/transient.el index 6153b502f7..5f66a13094 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -7,7 +7,7 @@ ;; Keywords: bindings ;; Package-Requires: ((emacs "25.1")) -;; Package-Version: 0.3.4 +;; Package-Version: 0.3.6 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -161,7 +161,12 @@ function should accept two arguments: a buffer to display and an alist of the same form as ALIST. See `display-buffer' for details. -The default is (display-buffer-in-side-window (side . bottom)). +The default is: + + (display-buffer-in-side-window + (side . bottom) + (inhibit-same-window . t)) + This displays the window at the bottom of the selected frame. Another useful value is (display-buffer-below-selected). This is what `magit-popup' used by default. For more alternatives @@ -234,6 +239,20 @@ and `transient-nonstandard-key'." :group 'transient :type 'boolean) +(defcustom transient-highlight-higher-levels nil + "Whether to highlight suffixes on higher levels. + +This is primarily intended for package authors. + +When non-nil then highlight the description of suffixes whose +level is above 4, the default of `transient-default-level'. +Assuming you have set that variable to 7, this highlights all +suffixes that won't be available to users without them making +the same customization." + :package-version '(transient . "0.3.6") + :group 'transient + :type 'boolean) + (defcustom transient-substitute-key-function nil "Function used to modify key bindings. @@ -296,7 +315,20 @@ be remapped to `fixed-pitch' in that buffer." :group 'transient :type 'boolean) -(defcustom transient-default-level 4 +(defcustom transient-force-single-column nil + "Whether to force use of a single column to display suffixes. + +This might be useful for users with low vision who use large +text and might otherwise have to scroll in two dimensions." + :package-version '(transient . "0.3.6") + :group 'transient + :type 'boolean) + +(defconst transient--default-child-level 1) + +(defconst transient--default-prefix-level 4) + +(defcustom transient-default-level transient--default-prefix-level "Control what suffix levels are made available by default. Each suffix command is placed on a level and each prefix command @@ -430,6 +462,11 @@ See info node `(transient)Enabling and Disabling Suffixes'." See info node `(transient)Enabling and Disabling Suffixes'." :group 'transient-faces) +(defface transient-higher-level '((t :underline t)) + "Face optionally used to highlight suffixes on higher levels. +Also see option `transient-highlight-higher-levels'." + :group 'transient-faces) + (defface transient-separator `((((class color) (background light)) ,@(and (>= emacs-major-version 27) '(:extend t)) @@ -569,7 +606,7 @@ the prototype is stored in the clone's `prototype' slot.") (defclass transient-child () ((level :initarg :level - :initform 1 + :initform (symbol-value 'transient--default-child-level) :documentation "Enable if level of prefix is equal or greater.") (if :initarg :if @@ -932,7 +969,7 @@ example, sets a variable use `transient-define-infix' instead. (if (eq k :class) (setq class pop) (setq args (plist-put args k pop))))) - (vector (or level 1) + (vector (or level transient--default-child-level) (or class (if (vectorp car) 'transient-columns @@ -1003,7 +1040,7 @@ example, sets a variable use `transient-define-infix' instead. (unless (plist-get args :key) (when-let ((shortarg (plist-get args :shortarg))) (setq args (plist-put args :key shortarg)))) - (list (or level 1) + (list (or level transient--default-child-level) (or class 'transient-suffix) args))) @@ -1968,6 +2005,11 @@ value. Otherwise return CHILDREN as is." (defun transient--post-command () (transient--debug 'post-command) + (unless this-command + (transient--debug "-- force pre-exit from post-command") + (message "Quit transient!") + (transient--pre-exit) + (setq transient--exitp t)) (if transient--exitp (progn (unless (and (eq transient--exitp 'replace) @@ -2043,7 +2085,8 @@ value. Otherwise return CHILDREN as is." (if (symbolp arg) (message "-- %-16s (cmd: %s, event: %S, exit: %s)" arg - (transient--suffix-symbol this-command) + (or (transient--suffix-symbol this-command) + (list this-command this-original-command last-command)) (key-description (this-command-keys-vector)) transient--exitp) (apply #'message arg args)))) @@ -2913,13 +2956,21 @@ have a history of their own.") (cw (mapcar (lambda (col) (apply #'max (mapcar #'length col))) columns)) (cc (transient--seq-reductions-from (apply-partially #'+ 3) cw 0))) - (dotimes (r rs) - (dotimes (c cs) - (insert (make-string (- (nth c cc) (current-column)) ?\s)) - (when-let ((cell (nth r (nth c columns)))) - (insert cell)) - (when (= c (1- cs)) - (insert ?\n)))))) + (if transient-force-single-column + (dotimes (c cs) + (dotimes (r rs) + (when-let ((cell (nth r (nth c columns)))) + (unless (equal cell "") + (insert cell ?\n)))) + (unless (= c (1- cs)) + (insert ?\n))) + (dotimes (r rs) + (dotimes (c cs) + (insert (make-string (- (nth c cc) (current-column)) ?\s)) + (when-let ((cell (nth r (nth c columns)))) + (insert cell)) + (when (= c (1- cs)) + (insert ?\n))))))) (cl-defmethod transient--insert-group ((group transient-subgroups)) (let* ((subgroups (oref group suffixes)) @@ -2974,9 +3025,7 @@ Optional support for popup buttons is also implemented here." 'transient-disabled-suffix)))) (cl-call-next-method obj)))) (when (oref obj inapt) - (set-text-properties 0 (length str) - (list 'face 'transient-inapt-suffix) - str)) + (add-face-text-property 0 (length str) 'transient-inapt-suffix nil str)) (if transient-enable-popup-navigation (make-text-button str nil 'type 'transient-button @@ -3088,9 +3137,15 @@ If the OBJ's `key' is currently unreachable, then apply the face (funcall (oref transient--prefix suffix-description) obj)) (propertize "(BUG: no description)" 'face 'error)))) - (if (transient--key-unreachable-p obj) - (propertize desc 'face 'transient-unreachable) - desc))) + (cond ((transient--key-unreachable-p obj) + (propertize desc 'face 'transient-unreachable)) + ((and transient-highlight-higher-levels + (> (oref obj level) transient--default-prefix-level)) + (add-face-text-property + 0 (length desc) 'transient-higher-level nil desc) + desc) + (t + desc)))) (cl-defgeneric transient-format-value (obj) "Format OBJ's value for display and return the result.") @@ -3192,13 +3247,16 @@ Show the first one that is specified." (transient--show-manpage manpage) (transient--describe-function (oref obj command))))) -(cl-defmethod transient-show-help ((_ transient-suffix)) +(cl-defmethod transient-show-help ((obj transient-suffix)) "Show the command doc-string." (if (eq this-original-command 'transient-help) (if-let ((manpage (oref transient--prefix man-page))) (transient--show-manpage manpage) (transient--describe-function (oref transient--prefix command))) - (transient--describe-function this-original-command))) + (if-let ((prefix (get (transient--suffix-command obj) 'transient--prefix)) + (manpage (oref prefix man-page))) + (transient--show-manpage manpage) + (transient--describe-function this-original-command)))) (cl-defmethod transient-show-help ((obj transient-infix)) "Show the manpage if defined or the command doc-string. commit 6a0db9a2dbbc9344c6fb3268417a75001c1c4843 Author: Glenn Morris Date: Thu Jul 1 06:28:40 2021 -0700 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index f490bfbb35..89154ae895 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -511,14 +511,17 @@ Return t if `allout-mode' is active in current buffer." nil t) (autoload 'allout-mode "allout" "\ Toggle Allout outline mode. -If called interactively, toggle `Allout mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Allout +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `allout-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -832,14 +835,17 @@ See `allout-widgets-mode' for allout widgets mode features.") (autoload 'allout-widgets-mode "allout-widgets" "\ Toggle Allout Widgets mode. -If called interactively, toggle `Allout-Widgets mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Allout-Widgets mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `allout-widgets-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1258,14 +1264,17 @@ Entering array mode calls the function `array-mode-hook'. (autoload 'artist-mode "artist" "\ Toggle Artist mode. -If called interactively, toggle `Artist mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Artist +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `artist-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1597,14 +1606,17 @@ or call the function `autoarg-kp-mode'.") (autoload 'autoarg-kp-mode "autoarg" "\ Toggle Autoarg-KP mode, a global minor mode. -If called interactively, toggle `Autoarg-Kp mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Autoarg-Kp +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'autoarg-kp-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1659,14 +1671,17 @@ or call the function `auto-insert-mode'.") (autoload 'auto-insert-mode "autoinsert" "\ Toggle Auto-insert mode, a global minor mode. -If called interactively, toggle `Auto-Insert mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Auto-Insert mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'auto-insert-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1752,14 +1767,17 @@ should be non-nil)." nil nil) (autoload 'auto-revert-mode "autorevert" "\ Toggle reverting buffer when the file changes (Auto-Revert Mode). -If called interactively, toggle `Auto-Revert mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Auto-Revert mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `auto-revert-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1785,14 +1803,17 @@ This function is designed to be added to hooks, for example: (autoload 'auto-revert-tail-mode "autorevert" "\ Toggle reverting tail of buffer when the file grows. -If called interactively, toggle `Auto-Revert-Tail mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Auto-Revert-Tail mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `auto-revert-tail-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1832,14 +1853,17 @@ or call the function `global-auto-revert-mode'.") (autoload 'global-auto-revert-mode "autorevert" "\ Toggle Global Auto-Revert Mode. -If called interactively, toggle `Global Auto-Revert mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Global +Auto-Revert mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'global-auto-revert-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1969,14 +1993,17 @@ or call the function `display-battery-mode'.") (autoload 'display-battery-mode "battery" "\ Toggle battery status display in mode line (Display Battery mode). -If called interactively, toggle `Display-Battery mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Display-Battery mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'display-battery-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -2592,7 +2619,7 @@ Emacs 28.1 and will be removed in a future release. \(fn URL &optional KIND)" nil nil) (autoload 'browse-url-of-file "browse-url" "\ -Ask a WWW browser to display FILE. +Use a web browser to display FILE. Display the current buffer's file if FILE is nil or if called interactively. Turn the filename into a URL with function `browse-url-file-url'. Pass the URL to a browser using the @@ -2601,7 +2628,9 @@ interactively. Turn the filename into a URL with function \(fn &optional FILE)" t nil) (autoload 'browse-url-of-buffer "browse-url" "\ -Ask a WWW browser to display BUFFER. +Use a web browser to display BUFFER. +See `browse-url' for details. + Display the current buffer if BUFFER is nil. Display only the currently visible part of BUFFER (from a temporary file) if buffer is narrowed. @@ -2612,19 +2641,24 @@ narrowed. In Dired, ask a WWW browser to display the file named on this line." t nil) (autoload 'browse-url-of-region "browse-url" "\ -Ask a WWW browser to display the current region. +Use a web browser to display the current region. +See `browse-url' for details. \(fn MIN MAX)" t nil) (autoload 'browse-url "browse-url" "\ -Ask a WWW browser to load URL. -Prompt for a URL, defaulting to the URL at or before point. -Invokes a suitable browser function which does the actual job. +Open URL using a configurable method. +This will typically (by default) open URL with an external web +browser, but a wide variety of different methods can be used, +depending on the URL type. The variables `browse-url-browser-function', `browse-url-handlers', and `browse-url-default-handlers' determine which browser function to use. +This command prompts for a URL, defaulting to the URL at or +before point. + The additional ARGS are passed to the browser function. See the doc strings of the actual functions, starting with `browse-url-browser-function', for information about the @@ -2636,8 +2670,8 @@ If ARGS are omitted, the default is to pass \(fn URL &rest ARGS)" t nil) (autoload 'browse-url-at-point "browse-url" "\ -Ask a WWW browser to load the URL at or before point. -Variable `browse-url-browser-function' says which browser to use. +Open URL at point using a configurable method. +See `browse-url' for details. Optional prefix argument ARG non-nil inverts the value of the option `browse-url-new-window-flag'. @@ -2653,10 +2687,11 @@ opposite of the browser kind of `browse-url-browser-function'. \(fn KIND URL &optional ARG)" t nil) (autoload 'browse-url-at-mouse "browse-url" "\ -Ask a WWW browser to load a URL clicked with the mouse. -The URL is the one around or before the position of the mouse click -but point is not changed. Variable `browse-url-browser-function' -says which browser to use. +Use a web browser to load a URL clicked with the mouse. +See `browse-url' for details. + +The URL is the one around or before the position of the mouse +click but point is not changed. \(fn EVENT)" t nil) @@ -2894,6 +2929,13 @@ from `browse-url-elinks-wrapper'. \(fn URL &optional NEW-WINDOW)" t nil) +(autoload 'browse-url-button-open-url "browse-url" "\ +Open URL using `browse-url'. +If `current-prefix-arg' is non-nil, use +`browse-url-secondary-browser-function' instead. + +\(fn URL)" nil nil) + (register-definition-prefixes "browse-url" '("browse-url-")) ;;;*** @@ -2967,14 +3009,17 @@ columns on its right towards the left. (autoload 'bug-reference-mode "bug-reference" "\ Toggle hyperlinking bug references in the buffer (Bug Reference mode). -If called interactively, toggle `Bug-Reference mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Bug-Reference mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `bug-reference-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -2983,14 +3028,17 @@ disabled. (autoload 'bug-reference-prog-mode "bug-reference" "\ Like `bug-reference-mode', but only buttonize in comments and strings. -If called interactively, toggle `Bug-Reference-Prog mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Bug-Reference-Prog mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `bug-reference-prog-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -3140,7 +3188,7 @@ and corresponding effects. \(fn &optional ARG)" nil nil) -(register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte-" "displaying-byte-compile-warnings" "emacs-lisp-" "no-byte-compile")) +(register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte" "displaying-byte-compile-warnings" "emacs-lisp-" "no-byte-compile")) ;;;*** @@ -4727,14 +4775,17 @@ Prefix argument is the same as for `checkdoc-defun'." t nil) (autoload 'checkdoc-minor-mode "checkdoc" "\ Toggle automatic docstring checking (Checkdoc minor mode). -If called interactively, toggle `Checkdoc minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Checkdoc +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `checkdoc-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -4843,14 +4894,18 @@ or call the function `cl-font-lock-built-in-mode'.") (autoload 'cl-font-lock-built-in-mode "cl-font-lock" "\ Highlight built-in functions, variables, and types in `lisp-mode'. -If called interactively, toggle `Cl-Font-Lock-Built-In mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'cl-font-lock-built-in-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5075,14 +5130,17 @@ This can be needed when using code byte-compiled using the old macro-expansion of `cl-defstruct' that used vectors objects instead of record objects. -If called interactively, toggle `Cl-Old-Struct-Compat mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Cl-Old-Struct-Compat mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'cl-old-struct-compat-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5370,13 +5428,13 @@ Use this from the command line, with ‘-batch’; it won’t work in an interactive Emacs. Native compilation equivalent to `batch-byte-compile'." nil nil) -(autoload 'batch-byte-native-compile-for-bootstrap "comp" "\ +(autoload 'batch-byte+native-compile "comp" "\ Like `batch-native-compile', but used for bootstrap. Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system -directory (the last entry in `native-comp-eln-load-path'). -If the environment variable 'NATIVE_DISABLED' is set, only byte -compile." nil nil) +directory (the last entry in `native-comp-eln-load-path') unless +`native-compile-target-directory' is non-nil. If the environment +variable 'NATIVE_DISABLED' is set, only byte compile." nil nil) (autoload 'native-compile-async "comp" "\ Compile FILES asynchronously. @@ -5604,14 +5662,18 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see). (autoload 'compilation-shell-minor-mode "compile" "\ Toggle Compilation Shell minor mode. -If called interactively, toggle `Compilation-Shell minor mode'. If -the prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Compilation-Shell minor mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `compilation-shell-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5625,14 +5687,17 @@ See `compilation-mode'. (autoload 'compilation-minor-mode "compile" "\ Toggle Compilation minor mode. -If called interactively, toggle `Compilation minor mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Compilation minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `compilation-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5668,14 +5733,17 @@ or call the function `dynamic-completion-mode'.") (autoload 'dynamic-completion-mode "completion" "\ Toggle dynamic word-completion on or off. -If called interactively, toggle `Dynamic-Completion mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Dynamic-Completion mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'dynamic-completion-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6234,14 +6302,17 @@ or call the function `cua-mode'.") (autoload 'cua-mode "cua-base" "\ Toggle Common User Access style editing (CUA mode). -If called interactively, toggle `Cua mode'. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. +This is a minor mode. If called interactively, toggle the `Cua mode' +mode. If the prefix argument is positive, enable the mode, and if it +is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'cua-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6288,14 +6359,17 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated. -If called interactively, toggle `Cua-Rectangle-Mark mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Cua-Rectangle-Mark mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `cua-rectangle-mark-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6317,14 +6391,17 @@ By convention, this is a list of symbols where each symbol stands for the (autoload 'cursor-intangible-mode "cursor-sensor" "\ Keep cursor outside of any `cursor-intangible' text property. -If called interactively, toggle `Cursor-Intangible mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Cursor-Intangible mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `cursor-intangible-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6338,14 +6415,17 @@ where WINDOW is the affected window, OLDPOS is the last known position of the cursor and DIR can be `entered' or `left' depending on whether the cursor is entering the area covered by the text-property property or leaving it. -If called interactively, toggle `Cursor-Sensor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Cursor-Sensor mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `cursor-sensor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6724,14 +6804,17 @@ Mode used for cvs status output. (autoload 'cwarn-mode "cwarn" "\ Minor mode that highlights suspicious C and C++ constructions. -If called interactively, toggle `Cwarn mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Cwarn +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `cwarn-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7189,14 +7272,17 @@ or call the function `delete-selection-mode'.") (autoload 'delete-selection-mode "delsel" "\ Toggle Delete Selection mode. -If called interactively, toggle `Delete-Selection mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Delete-Selection mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'delete-selection-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7211,7 +7297,8 @@ information on adapting behavior of commands in Delete Selection mode. (autoload 'delete-active-region "delsel" "\ Delete the active region. -If KILLP in not-nil, the active region is killed instead of deleted. +If KILLP is non-nil, or if called interactively with a prefix argument, +the active region is killed instead of deleted. \(fn &optional KILLP)" t nil) @@ -7373,14 +7460,17 @@ or call the function `desktop-save-mode'.") (autoload 'desktop-save-mode "desktop" "\ Toggle desktop saving (Desktop Save mode). -If called interactively, toggle `Desktop-Save mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Desktop-Save mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'desktop-save-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7855,14 +7945,17 @@ a diff with \\[diff-reverse-direction]. (autoload 'diff-minor-mode "diff-mode" "\ Toggle Diff minor mode. -If called interactively, toggle `Diff minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Diff minor +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `diff-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7878,8 +7971,10 @@ disabled. ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ -Query addresses of a DOMAIN using dig, by calling `dig-invoke'. -Optional arguments are passed to `dig-invoke'. +Query addresses of a DOMAIN using dig. +See `dig-invoke' for an explanation for the parameters. +When called interactively, DOMAIN is prompted for. If given a prefix, +also prompt for the QUERY-TYPE parameter. \(fn DOMAIN &optional QUERY-TYPE QUERY-CLASS QUERY-OPTION DIG-OPTION SERVER)" t nil) @@ -8042,14 +8137,17 @@ Like \\[dired-jump] (`dired-jump') but in other window. (autoload 'dirtrack-mode "dirtrack" "\ Toggle directory tracking in shell buffers (Dirtrack mode). -If called interactively, toggle `Dirtrack mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Dirtrack +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `dirtrack-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -8219,14 +8317,18 @@ in `.emacs'. Toggle display of fill-column indicator. This uses `display-fill-column-indicator' internally. -If called interactively, toggle `Display-Fill-Column-Indicator mode'. -If the prefix argument is positive, enable the mode, and if it is zero -or negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Display-Fill-Column-Indicator mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `display-fill-column-indicator-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -8296,14 +8398,17 @@ list.") Toggle display of line numbers in the buffer. This uses `display-line-numbers' internally. -If called interactively, toggle `Display-Line-Numbers mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Display-Line-Numbers mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `display-line-numbers-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -8446,14 +8551,17 @@ to the next best mode." nil nil) (autoload 'doc-view-minor-mode "doc-view" "\ Toggle displaying buffer via Doc View (Doc View minor mode). -If called interactively, toggle `Doc-View minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Doc-View +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `doc-view-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -8514,14 +8622,17 @@ Switch to *doctor* buffer and start giving psychotherapy." t nil) (autoload 'double-mode "double" "\ Toggle special insertion on double keypresses (Double mode). -If called interactively, toggle `Double mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Double +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `double-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -9211,14 +9322,17 @@ or call the function `global-ede-mode'.") (autoload 'global-ede-mode "ede" "\ Toggle global EDE (Emacs Development Environment) mode. -If called interactively, toggle `Global Ede mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Global Ede +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'global-ede-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10065,14 +10179,17 @@ or call the function `electric-pair-mode'.") (autoload 'electric-pair-mode "elec-pair" "\ Toggle automatic parens pairing (Electric Pair mode). -If called interactively, toggle `Electric-Pair mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Electric-Pair mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'electric-pair-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10089,14 +10206,17 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'. (autoload 'electric-pair-local-mode "elec-pair" "\ Toggle `electric-pair-mode' only in this buffer. -If called interactively, toggle `Electric-Pair-Local mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Electric-Pair-Local mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(buffer-local-value 'electric-pair-mode (current-buffer))'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10312,14 +10432,17 @@ Minor mode for editing text/enriched files. These are files with embedded formatting information in the MIME standard text/enriched format. -If called interactively, toggle `Enriched mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Enriched +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `enriched-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10597,14 +10720,17 @@ enough, since keyservers have strict timeout settings. (autoload 'epa-mail-mode "epa-mail" "\ A minor-mode for composing encrypted/clearsigned mails. -If called interactively, toggle `epa-mail mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `epa-mail +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `epa-mail-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10667,14 +10793,17 @@ or call the function `epa-global-mail-mode'.") (autoload 'epa-global-mail-mode "epa-mail" "\ Minor mode to hook EasyPG into Mail mode. -If called interactively, toggle `Epa-Global-Mail mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Epa-Global-Mail mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'epa-global-mail-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10759,7 +10888,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc :server \"chat.freenode.net\" :full-name \"Harry S Truman\") + (erc :server \"chat.freenode.net\" :full-name \"J. Random Hacker\") then the server and full-name will be set to those values, whereas `erc-compute-port' and `erc-compute-nick' will be invoked @@ -10786,7 +10915,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc-tls :server \"chat.freenode.net\" :full-name \"Harry S Truman\") + (erc-tls :server \"chat.freenode.net\" :full-name \"J. Random Hacker\") then the server and full-name will be set to those values, whereas `erc-compute-port' and `erc-compute-nick' will be invoked @@ -11318,7 +11447,7 @@ argument is passed to `next-file', which see). (autoload 'tags-search "etags" "\ Search through all files listed in tags table for match for REGEXP. Stops when a match is found. -To continue searching for next match, use command \\[tags-loop-continue]. +To continue searching for next match, use the command \\[fileloop-continue]. If FILES if non-nil should be a list or an iterator returning the files to search. The search will be restricted to these files. @@ -11331,7 +11460,7 @@ Also see the documentation of the `tags-file-name' variable. Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace -with the command \\[tags-loop-continue]. +with the command \\[fileloop-continue]. For non-interactive use, superseded by `fileloop-initialize-replace'. \(fn FROM TO &optional DELIMITED FILES)" t nil) @@ -12078,14 +12207,17 @@ a top-level keymap, `text-scale-increase' or (autoload 'buffer-face-mode "face-remap" "\ Minor mode for a buffer-specific default face. -If called interactively, toggle `Buffer-Face mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Buffer-Face mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `buffer-face-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13034,14 +13166,17 @@ region is invalid. This function saves match data. (autoload 'flymake-mode "flymake" "\ Toggle Flymake mode on or off. -If called interactively, toggle `Flymake mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Flymake +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `flymake-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13122,14 +13257,17 @@ Turn on `flyspell-mode' for comments and strings." t nil) (autoload 'flyspell-mode "flyspell" "\ Toggle on-the-fly spell checking (Flyspell mode). -If called interactively, toggle `Flyspell mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Flyspell +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `flyspell-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13205,14 +13343,17 @@ Turn off Follow mode. Please see the function `follow-mode'." nil nil) (autoload 'follow-mode "follow" "\ Toggle Follow mode. -If called interactively, toggle `Follow mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Follow +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `follow-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13335,14 +13476,17 @@ selected if the original window is the first one in the frame. (autoload 'footnote-mode "footnote" "\ Toggle Footnote mode. -If called interactively, toggle `Footnote mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Footnote +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `footnote-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13805,14 +13949,17 @@ being transferred. This list may grow up to a size of `gdb-debug-log-max' after which the oldest element (at the end of the list) is deleted every time a new one is added (at the front). -If called interactively, toggle `Gdb-Enable-Debug mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Gdb-Enable-Debug mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'gdb-enable-debug)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13989,14 +14136,17 @@ regular expression that can be used as an element of (autoload 'glasses-mode "glasses" "\ Minor mode for making identifiers likeThis readable. -If called interactively, toggle `Glasses mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Glasses +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `glasses-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -14604,14 +14754,17 @@ If FORCE is non-nil, replace the old ones. (autoload 'gnus-mailing-list-mode "gnus-ml" "\ Minor mode for providing mailing-list commands. -If called interactively, toggle `Gnus-Mailing-List mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Gnus-Mailing-List mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `gnus-mailing-list-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -15071,14 +15224,17 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and (autoload 'goto-address-mode "goto-addr" "\ Minor mode to buttonize URLs and e-mail addresses in the current buffer. -If called interactively, toggle `Goto-Address mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Goto-Address mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `goto-address-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -15112,14 +15268,17 @@ See `goto-address-mode' for more information on Goto-Address mode. (autoload 'goto-address-prog-mode "goto-addr" "\ Like `goto-address-mode', but only for comments and strings. -If called interactively, toggle `Goto-Address-Prog mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Goto-Address-Prog mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `goto-address-prog-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -15452,14 +15611,17 @@ or call the function `gud-tooltip-mode'.") (autoload 'gud-tooltip-mode "gud" "\ Toggle the display of GUD tooltips. -If called interactively, toggle `Gud-Tooltip mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Gud-Tooltip mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'gud-tooltip-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16190,14 +16352,17 @@ This discards the buffer's undo information." t nil) (autoload 'hi-lock-mode "hi-lock" "\ Toggle selective highlighting of patterns (Hi Lock mode). -If called interactively, toggle `Hi-Lock mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Hi-Lock +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `hi-lock-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16401,14 +16566,17 @@ Add patterns from the current buffer to the list of hi-lock patterns." t nil) (autoload 'hide-ifdef-mode "hideif" "\ Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode). -If called interactively, toggle `Hide-Ifdef mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Hide-Ifdef +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `hide-ifdef-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16486,14 +16654,17 @@ whitespace. Case does not matter.") (autoload 'hs-minor-mode "hideshow" "\ Minor mode to selectively hide/show code and comment blocks. -If called interactively, toggle `hs minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `hs minor +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `hs-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16536,14 +16707,17 @@ Unconditionally turn off `hs-minor-mode'." nil nil) (autoload 'highlight-changes-mode "hilit-chg" "\ Toggle highlighting changes in this buffer (Highlight Changes mode). -If called interactively, toggle `Highlight-Changes mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Highlight-Changes mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `highlight-changes-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16567,14 +16741,18 @@ buffer with the contents of a file (autoload 'highlight-changes-visible-mode "hilit-chg" "\ Toggle visibility of highlighting due to Highlight Changes mode. -If called interactively, toggle `Highlight-Changes-Visible mode'. If -the prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Highlight-Changes-Visible mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `highlight-changes-visible-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16717,14 +16895,17 @@ argument VERBOSE non-nil makes the function verbose. (autoload 'hl-line-mode "hl-line" "\ Toggle highlighting of the current line (Hl-Line mode). -If called interactively, toggle `Hl-Line mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Hl-Line +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `hl-line-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16753,14 +16934,17 @@ or call the function `global-hl-line-mode'.") (autoload 'global-hl-line-mode "hl-line" "\ Toggle line highlighting in all buffers (Global Hl-Line mode). -If called interactively, toggle `Global Hl-Line mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Global +Hl-Line mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'global-hl-line-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -17171,14 +17355,17 @@ or call the function `fido-mode'.") (autoload 'fido-mode "icomplete" "\ An enhanced `icomplete-mode' that emulates `ido-mode'. -If called interactively, toggle `Fido mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Fido mode' +mode. If the prefix argument is positive, enable the mode, and if it +is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'fido-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -17200,14 +17387,17 @@ or call the function `icomplete-mode'.") (autoload 'icomplete-mode "icomplete" "\ Toggle incremental minibuffer completion (Icomplete mode). -If called interactively, toggle `Icomplete mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Icomplete +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'icomplete-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -17239,14 +17429,17 @@ or call the function `icomplete-vertical-mode'.") (autoload 'icomplete-vertical-mode "icomplete" "\ Toggle vertical candidate display in `icomplete-mode' or `fido-mode'. -If called interactively, toggle `Icomplete-Vertical mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Icomplete-Vertical mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'icomplete-vertical-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -17778,14 +17971,17 @@ See `inferior-emacs-lisp-mode' for details. (autoload 'iimage-mode "iimage" "\ Toggle Iimage mode on or off. -If called interactively, toggle `Iimage mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Iimage +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `iimage-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -18098,14 +18294,17 @@ Setup easy-to-use keybindings for the commands to be used in dired mode. Note that n, p and and will be hijacked and bound to `image-dired-dired-x-line'. -If called interactively, toggle `Image-Dired minor mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Image-Dired minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `image-dired-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -18200,14 +18399,17 @@ or call the function `auto-image-file-mode'.") (autoload 'auto-image-file-mode "image-file" "\ Toggle visiting of image files as images (Auto Image File mode). -If called interactively, toggle `Auto-Image-File mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Auto-Image-File mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'auto-image-file-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -18235,14 +18437,17 @@ Key bindings: (autoload 'image-minor-mode "image-mode" "\ Toggle Image minor mode in this buffer. -If called interactively, toggle `Image minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Image +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `image-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -19179,14 +19384,17 @@ available on the net." t nil) (autoload 'ispell-minor-mode "ispell" "\ Toggle last-word spell checking (Ispell minor mode). -If called interactively, toggle `ISpell minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `ISpell +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `ispell-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -19874,14 +20082,17 @@ sleep in seconds. (autoload 'linum-mode "linum" "\ Toggle display of line numbers in the left margin (Linum mode). -If called interactively, toggle `Linum mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Linum +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `linum-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -20452,14 +20663,17 @@ or call the function `mail-abbrevs-mode'.") (autoload 'mail-abbrevs-mode "mailabbrev" "\ Toggle abbrev expansion of mail aliases (Mail Abbrevs mode). -If called interactively, toggle `Mail-Abbrevs mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Mail-Abbrevs mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'mail-abbrevs-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -20831,14 +21045,17 @@ Default bookmark handler for Man buffers. (autoload 'master-mode "master" "\ Toggle Master mode. -If called interactively, toggle `Master mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Master +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `master-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -20873,14 +21090,18 @@ or call the function `minibuffer-depth-indicate-mode'.") (autoload 'minibuffer-depth-indicate-mode "mb-depth" "\ Toggle Minibuffer Depth Indication mode. -If called interactively, toggle `Minibuffer-Depth-Indicate mode'. If -the prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Minibuffer-Depth-Indicate mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'minibuffer-depth-indicate-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -21438,14 +21659,17 @@ or call the function `midnight-mode'.") (autoload 'midnight-mode "midnight" "\ Non-nil means run `midnight-hook' at midnight. -If called interactively, toggle `Midnight mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Midnight +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'midnight-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -21490,14 +21714,18 @@ or call the function `minibuffer-electric-default-mode'.") (autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\ Toggle Minibuffer Electric Default mode. -If called interactively, toggle `Minibuffer-Electric-Default mode'. -If the prefix argument is positive, enable the mode, and if it is zero -or negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Minibuffer-Electric-Default mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'minibuffer-electric-default-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -22071,14 +22299,17 @@ or call the function `msb-mode'.") (autoload 'msb-mode "msb" "\ Toggle Msb mode. -If called interactively, toggle `Msb mode'. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. +This is a minor mode. If called interactively, toggle the `Msb mode' +mode. If the prefix argument is positive, enable the mode, and if it +is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'msb-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -22387,14 +22618,17 @@ or call the function `mouse-wheel-mode'." :set #'custom-set-minor-mode :initiali (autoload 'mouse-wheel-mode "mwheel" "\ Toggle mouse wheel support (Mouse Wheel mode). -If called interactively, toggle `Mouse-Wheel mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Mouse-Wheel mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'mouse-wheel-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -24360,14 +24594,17 @@ Turning on outline mode calls the value of `text-mode-hook' and then of (autoload 'outline-minor-mode "outline" "\ Toggle Outline minor mode. -If called interactively, toggle `Outline minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Outline +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `outline-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -24601,14 +24838,17 @@ or call the function `show-paren-mode'.") (autoload 'show-paren-mode "paren" "\ Toggle visualization of matching parens (Show Paren mode). -If called interactively, toggle `Show-Paren mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Show-Paren +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'show-paren-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -25314,14 +25554,17 @@ or call the function `pixel-scroll-mode'.") (autoload 'pixel-scroll-mode "pixel-scroll" "\ A minor mode to scroll text pixel-by-pixel. -If called interactively, toggle `Pixel-Scroll mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Pixel-Scroll mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'pixel-scroll-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -26006,8 +26249,12 @@ Proced buffers. (autoload 'profiler-start "profiler" "\ Start/restart profilers. MODE can be one of `cpu', `mem', or `cpu+mem'. -If MODE is `cpu' or `cpu+mem', time-based profiler will be started. -Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started. +If MODE is `cpu' or `cpu+mem', start the time-based profiler, + whereby CPU is sampled periodically using the SIGPROF signal. +If MODE is `mem' or `cpu+mem', start profiler that samples CPU + whenever memory-allocation functions are called -- this is useful + if SIGPROF is not supported, or is unreliable, or is not sampling + at a high enough frequency. \(fn MODE)" t nil) @@ -27078,14 +27325,17 @@ or call the function `rcirc-track-minor-mode'.") (autoload 'rcirc-track-minor-mode "rcirc" "\ Global minor mode for tracking activity in rcirc buffers. -If called interactively, toggle `Rcirc-Track minor mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Rcirc-Track minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'rcirc-track-minor-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27135,14 +27385,17 @@ or call the function `recentf-mode'.") (autoload 'recentf-mode "recentf" "\ Toggle \"Open Recent\" menu (Recentf mode). -If called interactively, toggle `Recentf mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Recentf +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'recentf-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27300,14 +27553,17 @@ with a prefix argument, prompt for START-AT and FORMAT. (autoload 'rectangle-mark-mode "rect" "\ Toggle the region as rectangular. -If called interactively, toggle `Rectangle-Mark mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Rectangle-Mark mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `rectangle-mark-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27339,14 +27595,17 @@ Activates the region if needed. Only lasts until the region is deactivated. (autoload 'refill-mode "refill" "\ Toggle automatic refilling (Refill mode). -If called interactively, toggle `Refill mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Refill +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `refill-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27376,14 +27635,17 @@ Turn on RefTeX mode." nil nil) (autoload 'reftex-mode "reftex" "\ Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX. -If called interactively, toggle `Reftex mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Reftex +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `reftex-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27606,20 +27868,23 @@ Toggle Repeat mode. When Repeat mode is enabled, and the command symbol has the property named `repeat-map', this map is activated temporarily for the next command. -If called interactively, toggle `Repeat mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Repeat +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'repeat-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. \(fn &optional ARG)" t nil) -(register-definition-prefixes "repeat" '("repeat-")) +(register-definition-prefixes "repeat" '("describe-repeat" "repeat-")) ;;;*** @@ -27692,14 +27957,17 @@ report errors as appropriate for this kind of usage. (autoload 'reveal-mode "reveal" "\ Toggle uncloaking of invisible text near point (Reveal mode). -If called interactively, toggle `Reveal mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Reveal +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `reveal-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27724,14 +27992,17 @@ or call the function `global-reveal-mode'.") Toggle Reveal mode in all buffers (Global Reveal mode). Reveal mode renders invisible text around point visible again. -If called interactively, toggle `Global Reveal mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Global +Reveal mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'global-reveal-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28265,14 +28536,17 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." t nil) (autoload 'rng-validate-mode "rng-valid" "\ Minor mode performing continual validation against a RELAX NG schema. -If called interactively, toggle `Rng-Validate mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Rng-Validate mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `rng-validate-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28422,14 +28696,17 @@ highlighting. (autoload 'rst-minor-mode "rst" "\ Toggle ReST minor mode. -If called interactively, toggle `Rst minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Rst minor +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `rst-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28478,14 +28755,17 @@ Use the command `ruler-mode' to change this variable.") (autoload 'ruler-mode "ruler-mode" "\ Toggle display of ruler in header line (Ruler mode). -If called interactively, toggle `Ruler mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Ruler +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `ruler-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28755,14 +29035,17 @@ or call the function `savehist-mode'.") (autoload 'savehist-mode "savehist" "\ Toggle saving of minibuffer history (Savehist mode). -If called interactively, toggle `Savehist mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Savehist +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'savehist-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28816,14 +29099,17 @@ Non-nil means automatically save place in each file. This means when you visit a file, point goes to the last place where it was when you previously visited the same file. -If called interactively, toggle `Save-Place mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Save-Place +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'save-place-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28835,14 +29121,17 @@ If this mode is enabled, point is recorded when you kill the buffer or exit Emacs. Visiting this file again will go to that position, even in a later Emacs session. -If called interactively, toggle `Save-Place-Local mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Save-Place-Local mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `save-place-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28929,14 +29218,17 @@ or call the function `scroll-all-mode'.") (autoload 'scroll-all-mode "scroll-all" "\ Toggle shared scrolling in same-frame windows (Scroll-All mode). -If called interactively, toggle `Scroll-All mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Scroll-All +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'scroll-all-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28962,14 +29254,17 @@ one window apply to all visible windows in the same frame. (autoload 'scroll-lock-mode "scroll-lock" "\ Buffer-local minor mode for pager-like scrolling. -If called interactively, toggle `Scroll-Lock mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Scroll-Lock mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `scroll-lock-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29038,14 +29333,17 @@ or call the function `semantic-mode'.") (autoload 'semantic-mode "semantic" "\ Toggle parser features (Semantic mode). -If called interactively, toggle `Semantic mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Semantic +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'semantic-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29707,14 +30005,17 @@ or call the function `server-mode'.") (autoload 'server-mode "server" "\ Toggle Server mode. -If called interactively, toggle `Server mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Server +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'server-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -30337,14 +30638,17 @@ buffer names. (autoload 'smerge-mode "smerge-mode" "\ Minor mode to simplify editing output from the diff3 program. -If called interactively, toggle `SMerge mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `SMerge +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `smerge-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -30470,14 +30774,17 @@ Open the so-long `customize' group." t nil) (autoload 'so-long-minor-mode "so-long" "\ This is the minor mode equivalent of `so-long-mode'. -If called interactively, toggle `So-Long minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `So-Long +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `so-long-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -30552,14 +30859,17 @@ or call the function `global-so-long-mode'.") (autoload 'global-so-long-mode "so-long" "\ Toggle automated performance mitigations for files with long lines. -If called interactively, toggle `Global So-Long mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Global +So-Long mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'global-so-long-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -31670,14 +31980,17 @@ or call the function `strokes-mode'.") (autoload 'strokes-mode "strokes" "\ Toggle Strokes mode, a global minor mode. -If called interactively, toggle `Strokes mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Strokes +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'strokes-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -31768,6 +32081,12 @@ Truncate STRING to LENGTH, replacing initial surplus with \"...\". \(fn STRING LENGTH)" nil nil) +(autoload 'string-lines "subr-x" "\ +Split STRING into a list of lines. +If OMIT-NULLS, empty lines will be removed from the results. + +\(fn STRING &optional OMIT-NULLS)" nil nil) + (register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "named-let" "replace-region-contents" "string-" "thread-" "when-let*")) ;;;*** @@ -31780,14 +32099,17 @@ Truncate STRING to LENGTH, replacing initial surplus with \"...\". (autoload 'subword-mode "subword" "\ Toggle subword movement and editing (Subword mode). -If called interactively, toggle `Subword mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Subword +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `subword-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -31839,14 +32161,17 @@ See `subword-mode' for more information on Subword mode. (autoload 'superword-mode "subword" "\ Toggle superword movement and editing (Superword mode). -If called interactively, toggle `Superword mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Superword +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `superword-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -31944,14 +32269,17 @@ or call the function `gpm-mouse-mode'.") (autoload 'gpm-mouse-mode "t-mouse" "\ Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). -If called interactively, toggle `Gpm-Mouse mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Gpm-Mouse +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'gpm-mouse-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -31975,14 +32303,17 @@ GPM. This is due to limitations in GPM and the Linux kernel. (autoload 'tab-line-mode "tab-line" "\ Toggle display of window tab line in the buffer. -If called interactively, toggle `Tab-Line mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Tab-Line +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `tab-line-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -32389,14 +32720,17 @@ location is indicated by `table-word-continuation-char'. This variable's value can be toggled by \\[table-fixed-width-mode] at run-time. -If called interactively, toggle `Table-Fixed-Width mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Table-Fixed-Width mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `table-fixed-width-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -33569,14 +33903,17 @@ This function is meant to be used as a `post-self-insert-hook'." t nil) (autoload 'tildify-mode "tildify" "\ Adds electric behavior to space character. -If called interactively, toggle `Tildify mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Tildify +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `tildify-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -33624,14 +33961,17 @@ or call the function `display-time-mode'.") (autoload 'display-time-mode "time" "\ Toggle display of time, load level, and mail flag in mode lines. -If called interactively, toggle `Display-Time mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Display-Time mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'display-time-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -33799,7 +34139,7 @@ look like one of the following: Time-stamp: <> Time-stamp: \" \" The time stamp is written between the brackets or quotes: - Time-stamp: <2001-02-18 10:20:51 gildea> + Time-stamp: <2020-08-07 17:10:21 gildea> The time stamp is updated only if the variable `time-stamp-active' is non-nil. @@ -33811,7 +34151,7 @@ The variables `time-stamp-pattern', `time-stamp-line-limit', (autoload 'time-stamp-toggle-active "time-stamp" "\ Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer. -With ARG, turn time stamping on if and only if arg is positive. +With ARG, turn time stamping on if and only if ARG is positive. \(fn &optional ARG)" t nil) @@ -34421,7 +34761,7 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 5 1 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 5 1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) @@ -34600,14 +34940,17 @@ or call the function `type-break-mode'.") Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. -If called interactively, toggle `Type-Break mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Type-Break +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'type-break-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -35131,14 +35474,17 @@ or call the function `url-handler-mode'.") (autoload 'url-handler-mode "url-handlers" "\ Toggle using `url' library for URL filenames (URL Handler mode). -If called interactively, toggle `Url-Handler mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Url-Handler mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'url-handler-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -37311,14 +37657,17 @@ own View-like bindings. (autoload 'view-mode "view" "\ Toggle View mode, a minor mode for viewing text but not editing it. -If called interactively, toggle `View mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `View mode' +mode. If the prefix argument is positive, enable the mode, and if it +is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `view-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -37690,14 +38039,17 @@ or call the function `which-function-mode'.") (autoload 'which-function-mode "which-func" "\ Toggle mode line display of current function (Which Function mode). -If called interactively, toggle `Which-Function mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Which-Function mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'which-function-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -37718,14 +38070,17 @@ in certain major modes. (autoload 'whitespace-mode "whitespace" "\ Toggle whitespace visualization (Whitespace mode). -If called interactively, toggle `Whitespace mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Whitespace +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `whitespace-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -37737,14 +38092,17 @@ See also `whitespace-style', `whitespace-newline' and (autoload 'whitespace-newline-mode "whitespace" "\ Toggle newline visualization (Whitespace Newline mode). -If called interactively, toggle `Whitespace-Newline mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Whitespace-Newline mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `whitespace-newline-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -37770,14 +38128,17 @@ or call the function `global-whitespace-mode'.") (autoload 'global-whitespace-mode "whitespace" "\ Toggle whitespace visualization globally (Global Whitespace mode). -If called interactively, toggle `Global Whitespace mode'. If the -prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Global +Whitespace mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'global-whitespace-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -37799,14 +38160,17 @@ or call the function `global-whitespace-newline-mode'.") (autoload 'global-whitespace-newline-mode "whitespace" "\ Toggle global newline visualization (Global Whitespace Newline mode). -If called interactively, toggle `Global Whitespace-Newline mode'. If -the prefix argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Global +Whitespace-Newline mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'global-whitespace-newline-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38129,14 +38493,17 @@ Show widget browser for WIDGET in other window. (autoload 'widget-minor-mode "wid-browse" "\ Minor mode for traversing widgets. -If called interactively, toggle `Widget minor mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the `Widget +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `widget-minor-mode'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38239,31 +38606,37 @@ unless `windmove-create-window' is non-nil and a new window is created. Set up keybindings for `windmove'. Keybindings are of the form MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers or a single modifier. +If MODIFIERS is `none', the keybindings will be directly bound to +the arrow keys. Default value of MODIFIERS is `shift'. \(fn &optional MODIFIERS)" t nil) (autoload 'windmove-display-left "windmove" "\ Display the next buffer in window to the left of the current one. -See the logic of the prefix ARG in `windmove-display-in-direction'. +See the logic of the prefix ARG and `windmove-display-no-select' +in `windmove-display-in-direction'. \(fn &optional ARG)" t nil) (autoload 'windmove-display-up "windmove" "\ Display the next buffer in window above the current one. -See the logic of the prefix ARG in `windmove-display-in-direction'. +See the logic of the prefix ARG and `windmove-display-no-select' +in `windmove-display-in-direction'. \(fn &optional ARG)" t nil) (autoload 'windmove-display-right "windmove" "\ Display the next buffer in window to the right of the current one. -See the logic of the prefix ARG in `windmove-display-in-direction'. +See the logic of the prefix ARG and `windmove-display-no-select' +in `windmove-display-in-direction'. \(fn &optional ARG)" t nil) (autoload 'windmove-display-down "windmove" "\ Display the next buffer in window below the current one. -See the logic of the prefix ARG in `windmove-display-in-direction'. +See the logic of the prefix ARG and `windmove-display-no-select' +in `windmove-display-in-direction'. \(fn &optional ARG)" t nil) @@ -38287,6 +38660,8 @@ Set up keybindings for directional buffer display. Keys are bound to commands that display the next buffer in the specified direction. Keybindings are of the form MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers or a single modifier. +If MODIFIERS is `none', the keybindings will be directly bound to +the arrow keys. Default value of MODIFIERS is `shift-meta'. \(fn &optional MODIFIERS)" t nil) @@ -38324,7 +38699,10 @@ Set up keybindings for directional window deletion. Keys are bound to commands that delete windows in the specified direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down}, where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or -a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'. +a single modifier. +If PREFIX is `none', no prefix is used. If MODIFIERS is `none', the keybindings +are directly bound to the arrow keys. +Default value of PREFIX is `C-x' and MODIFIERS is `shift'. \(fn &optional PREFIX MODIFIERS)" t nil) @@ -38345,7 +38723,10 @@ Set up keybindings for directional window swap states. Keys are bound to commands that swap the states of the selected window with the window in the specified direction. Keybindings are of the form MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers -or a single modifier. Default value of MODIFIERS is `shift-super'. +or a single modifier. +If MODIFIERS is `none', the keybindings will be directly bound to the +arrow keys. +Default value of MODIFIERS is `shift-super'. \(fn &optional MODIFIERS)" t nil) @@ -38369,14 +38750,17 @@ or call the function `winner-mode'.") (autoload 'winner-mode "winner" "\ Toggle Winner mode on or off. -If called interactively, toggle `Winner mode'. If the prefix argument -is positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Winner +mode' mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'winner-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38661,14 +39045,17 @@ or call the function `xterm-mouse-mode'.") (autoload 'xterm-mouse-mode "xt-mouse" "\ Toggle XTerm mouse mode. -If called interactively, toggle `Xterm-Mouse mode'. If the prefix -argument is positive, enable the mode, and if it is zero or negative, -disable the mode. +This is a minor mode. If called interactively, toggle the +`Xterm-Mouse mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value 'xterm-mouse-mode)'. + The mode's hook is called both when the mode is enabled and when it is disabled. commit d70dc6946a2c72974b91a6506e9c6237c85ce80d Author: Glenn Morris Date: Thu Jul 1 06:11:38 2021 -0700 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 655285e0f6..b0ab27bc4c 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -25860,8 +25860,12 @@ Proced buffers. (autoload 'profiler-start "profiler" "\ Start/restart profilers. MODE can be one of `cpu', `mem', or `cpu+mem'. -If MODE is `cpu' or `cpu+mem', time-based profiler will be started. -Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started. +If MODE is `cpu' or `cpu+mem', start the time-based profiler, + whereby CPU is sampled periodically using the SIGPROF signal. +If MODE is `mem' or `cpu+mem', start profiler that samples CPU + whenever memory-allocation functions are called -- this is useful + if SIGPROF is not supported, or is unreliable, or is not sampling + at a high enough frequency. \(fn MODE)" t nil) commit dc0ce5ff1129ae02e80fd7f505b085cc40037c64 Author: Mattias Engdegård Date: Thu Jul 1 14:27:13 2021 +0200 Update describe-prefix-binding manual text * doc/emacs/help.texi (Misc Help): `ESC ?` isn't unbound any more. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index f144fd2922..0caab681d3 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -629,13 +629,14 @@ Emacs Lisp Reference Manual}). @findex describe-prefix-bindings You can get a list of subcommands for a particular prefix key by -typing @kbd{C-h}, @kbd{?}, or @key{F1} +typing @kbd{C-h}, @kbd{?}, or @key{f1} (@code{describe-prefix-bindings}) after the prefix key. (There are a few prefix keys for which not all of these keys work---those that provide their own bindings for that key. One of these prefix keys -is @key{ESC}, because @kbd{@key{ESC} C-h} is actually @kbd{C-M-h}, -which marks a defun. However, @w{@kbd{@key{ESC} @key{F1}}} and -@w{@kbd{@key{ESC} ?}} work fine.) +is @key{ESC}, because @kbd{@key{ESC} C-h} and @kbd{@key{ESC} ?} are +actually @kbd{C-M-h} (@code{mark-defun}) and @kbd{M-?} +(@code{xref-find-references}), respectively. However, +@w{@kbd{@key{ESC} @key{f1}}} works fine.) @findex describe-keymap Finally, @kbd{M-x describe-keymap} prompts for the name of a keymap, commit 527bab054f285cde9d7f792c932c40ddcce74590 Author: Michael Albinus Date: Thu Jul 1 13:43:44 2021 +0200 Handle test environment variables * lisp/emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): Check also for EMACS_EMBA_CI. * test/README (SELECTOR): Mention EMACS_TEST_VERBOSE. * test/infra/gitlab-ci.yml (variables): Set EMACS_TEST_VERBOSE. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 50b45092ca..92acfe7246 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1552,7 +1552,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (when badtests (message "%d files did not finish:" (length badtests)) (mapc (lambda (l) (message " %s" l)) badtests) - (if (getenv "EMACS_HYDRA_CI") + (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) (with-temp-buffer (dolist (f badtests) (erase-buffer) @@ -1568,8 +1568,8 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (setq tests (sort tests (lambda (x y) (> (car x) (car y))))) (when (< high (length tests)) (setcdr (nthcdr (1- high) tests) nil)) (message "%s" (mapconcat #'cdr tests "\n"))) - ;; More details on hydra, where the logs are harder to get to. - (when (and (getenv "EMACS_HYDRA_CI") + ;; More details on hydra and emba, where the logs are harder to get to. + (when (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) (not (zerop (+ nunexpected nskipped)))) (message "\nDETAILS") (message "-------") diff --git a/test/README b/test/README index 0c8d5a409b..97611cf864 100644 --- a/test/README +++ b/test/README @@ -105,6 +105,11 @@ debugging. To do that, use make TEST_INTERACTIVE=yes ... +By default, ERT test failure summaries are quite brief in batch +mode--only the names of the failed tests are listed. If the +$EMACS_TEST_VERBOSE environment variable is set, the failure summaries +will also include the data from the failing test. + Some of the tests require a remote temporary directory (autorevert-tests.el, filenotify-tests.el, shadowfile-tests.el and tramp-tests.el). Per default, a mock-up connection method is used diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index fa10fa6761..6876a8b11d 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -44,6 +44,7 @@ workflow: variables: GIT_STRATEGY: fetch EMACS_EMBA_CI: 1 + EMACS_TEST_VERBOSE: 1 # # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled # DOCKER_HOST: tcp://docker:2376 # DOCKER_TLS_CERTDIR: "/certs" commit 1a7c8f846eb8cccf1d2439f8b03a171b1b6bd104 Author: Peter Oliver Date: Thu Jul 1 12:46:10 2021 +0200 Fix copy/paste error in emacsclient.desktop * etc/emacsclient.desktop: new-instance should read new-window. diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop index 361051e611..cd45463093 100644 --- a/etc/emacsclient.desktop +++ b/etc/emacsclient.desktop @@ -13,7 +13,7 @@ StartupWMClass=Emacs Keywords=Text;Editor; Actions=new-window;new-instance; -[Desktop Action new-instance] +[Desktop Action new-window] Name=New Window Exec=emacsclient --alternate-editor= --create-frame %F commit d898d3c73a1a51df36f7ec7318071be628b44427 Author: Eli Zaretskii Date: Thu Jul 1 11:31:05 2021 +0300 ; * doc/emacs/back.texi: Fix a typo. diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi index 717f7f5ab9..e1a2a04ecb 100644 --- a/doc/emacs/back.texi +++ b/doc/emacs/back.texi @@ -39,7 +39,7 @@ and creating Makefiles for GNU/Linux, UNIX, Windows/DOS, and VMS systems. @item -Support for typing and displaying in @strong{60 non- English languages}, +Support for typing and displaying in @strong{60 non-English languages}, including Arabic, Chinese, Czech, Hebrew, Hindi, Japanese, Korean, Russian, Vietnamese, and all Western European languages. commit de52dbd4ad4299681b7471d456516fd2c79262d7 Author: Eli Zaretskii Date: Thu Jul 1 11:28:05 2021 +0300 Update doc/emacs/ for a new printing of the Emacs Manual book * doc/emacs/book-spine.texi: New file: the printed book spine. * doc/emacs/back.texi: New file: the backcover text for the printed book. * doc/emacs/emacs.texi: Update ISBN. diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi new file mode 100644 index 0000000000..717f7f5ab9 --- /dev/null +++ b/doc/emacs/back.texi @@ -0,0 +1,98 @@ +\input texinfo @c -*-texinfo-*- +@c This is part of the Emacs manual. +@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software +@c Foundation, Inc. +@c See file emacs.texi for copying conditions. +@c +@c %**start of header +@setfilename back-cover +@settitle GNU Emacs Manual +@include docstyle.texi +@c %**end of header +. +@sp 7 +@center @titlefont {GNU Emacs Manual} +@sp 1 + +@quotation +GNU Emacs is much more than a text editor; over the years, it has +expanded to become an entire workflow environment, impressing +programmers with its integrated debugging and project-management +features. It is also a multi-lingual word processor, can handle all +your email and Usenet news needs, display web pages, and even has a +diary and a calendar for your appointments! + +And when you tire of all the work you can accomplish with it, Emacs +contains games to play. + +@strong{Features include:} + +@itemize @bullet +@item +Special editing modes for @strong{27 programing languages}, including C, +C@t{++}, Fortran, Java, JavaScript, Lisp, Objective C, Pascal, Perl, +and Scheme. + +@item +Special @strong{scripting language modes} for Bash, other common shells, +and creating Makefiles for GNU/Linux, UNIX, Windows/DOS, and VMS +systems. + +@item +Support for typing and displaying in @strong{60 non- English languages}, +including Arabic, Chinese, Czech, Hebrew, Hindi, Japanese, Korean, +Russian, Vietnamese, and all Western European languages. + +@item +The ability to: + +@itemize @minus +@item +Create @strong{PostScript output} from plain-text files (special editing +modes for @LaTeX{} and @TeX{} are included). + +@item +@strong{Compile} and @strong{debug} from inside Emacs. + +@item +Maintain program @strong{ChangeLogs}. + +@item +Flag, move, and delete files and sub-directories recursively +(@strong{directory navigation}). + +@item +Run @strong{shell commands} from inside Emacs, or even use Emacs itself +as a shell (Eshell). + +@item +Enjoy the use of extensive @strong{merge} and @strong{diff} functions. + +@item +Take advantage of built-in support for many @strong{version control} +systems, including Git, Mercurial, Bazaar, Subversion, and CVS. + +@item +And much more! +@end itemize +@end itemize + +Emacs comes with an introductory online tutorial available in many +languages. This book picks up where that tutorial ends. It explains +the full range of Emacs's power and contains reference material useful +to expert users. + +Appendices are included, with specific material about X and GTK +resources, and with details for users of Macintosh and Microsoft OS. + +@strong{About the Author:} + +Richard M.@: Stallman developed the first Emacs in 1975 and wrote GNU +Emacs in 1984/85. He has received the ACM Grace Hopper Award, a +MacArthur Foundation fellowship, the Electronic Frontier Foundation's +Pioneer award, and the Takeda Award for Social/Economic Betterment, as +well as several honorary doctorates. +@end quotation + +@hfil +@bye diff --git a/doc/emacs/book-spine.texi b/doc/emacs/book-spine.texi new file mode 100644 index 0000000000..84a0168c05 --- /dev/null +++ b/doc/emacs/book-spine.texi @@ -0,0 +1,20 @@ +\input texinfo @c -*-texinfo-*- +@c %**start of header +@setfilename book-spine +@settitle book-spine +@include docstyle.texi +@c %**end of header + +@include emacsver.texi + +@c need dot in text so first space command works! +. +@sp 7 + +@center @titlefont{GNU Emacs Manual} +@sp 5 +@center @value{EDITION} Edition, for Emacs Version @value{EMACSVER} +@sp 5 + +@center by Richard M.@: Stallman +@bye diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 4481ac9045..b355146ee8 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -92,7 +92,7 @@ developing GNU and promoting software freedom.'' Published by the Free Software Foundation @* 51 Franklin Street, Fifth Floor @* Boston, MA 02110-1301 USA @* -ISBN 978-0-9831592-5-4 +ISBN 978-0-9831592-8-5 @sp 2 Cover art by Etienne Suvasa; cover design by Matt Lee. commit fc3c00413ac4bf59e2a2e4c21ecaaac53e9fd8fa Author: Michael Albinus Date: Thu Jul 1 10:19:48 2021 +0200 Doc cleanup * doc/lispref/files.texi (File Locks, Changing Files) (File Name Components, File Name Expansion, Magic File Names): * lisp/files.el (locate-dominating-stop-dir-regexp) (auto-mode-alist, set-auto-mode, file-name-with-extension) (backup-directory-alist, wildcard-to-regexp) (save-buffers-kill-terminal): Doc fixes. * etc/NEWS: Fix typos. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index dd9ce2cd01..5238597a46 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -718,7 +718,7 @@ Emacs can then detect the first attempt to modify a buffer visiting a file that is locked by another Emacs job, and ask the user what to do. The file lock is really a file, a symbolic link with a special name, stored in the same directory as the file you are editing. The name is -constructed by prepending @file{.#} to the filename of the buffer. +constructed by prepending @file{.#} to the file name of the buffer. The target of the symbolic link will be of the form @code{@var{user}@@@var{host}.@var{pid}:@var{boot}}, where @var{user} is replaced with the current username (from @code{user-login-name}), @@ -1932,7 +1932,7 @@ is a symbolic link and @var{flag} is @code{nofollow}. @defun set-file-extended-attributes filename attribute-alist This function sets the Emacs-recognized extended file attributes for -@code{filename}. The second argument @var{attribute-alist} should be +@var{filename}. The second argument @var{attribute-alist} should be an alist of the same form returned by @code{file-extended-attributes}. The return value is @code{t} if the attributes are successfully set, otherwise it is @code{nil}. @@ -2145,7 +2145,7 @@ stripped if there is one. For example: Note that this function will error if @var{filename} or @var{extension} are empty, or if the @var{filename} is shaped like a -directory (i.e. if @code{directory-name-p} returns non-@code{nil}). +directory (i.e., if @code{directory-name-p} returns non-@code{nil}). @end defun @defun file-name-sans-extension filename @@ -2434,7 +2434,7 @@ might begin with a literal @samp{~}, you can use @code{(concat (file-name-as-directory directory) filename)} instead of @code{(expand-file-name filename directory)}. -Filenames containing @samp{.} or @samp{..} are simplified to their +File names containing @samp{.} or @samp{..} are simplified to their canonical form: @example @@ -3476,11 +3476,11 @@ identifies the remote system. This identifier string can include a host name and a user name, as well as characters designating the method used to access the remote -system. For example, the remote identifier string for the filename +system. For example, the remote identifier string for the file name @code{/sudo::/some/file} is @code{/sudo:root@@localhost:}. If @code{file-remote-p} returns the same identifier for two different -filenames, that means they are stored on the same file system and can +file names, that means they are stored on the same file system and can be accessed locally with respect to each other. This means, for example, that it is possible to start a remote process accessing both files at the same time. Implementers of file name handlers need to diff --git a/etc/NEWS b/etc/NEWS index 7e95c20498..605c4d228f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -173,7 +173,7 @@ looking at the doc string of a function that belongs to one of these groups. --- -** Improved "find definition" feature of *Help* buffers. +** Improved "find definition" feature of "*Help*" buffers. Now clicking on the link to find the definition of functions generated by 'cl-defstruct', or variables generated by 'define-derived-mode', for example, will go to the exact place where they are defined. @@ -906,7 +906,7 @@ String or list of strings specifying switches for Git log under VC. +++ *** New Summary buffer sort options for extra headers. The extra header sort option ('C-c C-s C-x') prompts for a header -and fails if no sort function has been defined. Sorting by +and fails if no sort function has been defined. Sorting by Newsgroups ('C-c C-s C-u') has been pre-defined. +++ @@ -1176,8 +1176,8 @@ can provide a better overview in a long list of available bindings. *** New keybinding 'C-h R' prompts for a manual to display and displays it. --- -*** Closing the *Help* buffer from the toolbar now buries the buffer. -In previous Emacs versions, the *Help* buffer was killed instead when +*** Closing the "*Help*" buffer from the toolbar now buries the buffer. +In previous Emacs versions, the "*Help*" buffer was killed instead when clicking the "X" icon in the tool bar. +++ @@ -1232,10 +1232,11 @@ There's also a Cham greeting in "etc/HELLO". --- *** New input methods for Lakota language orthographies. -Two orthographies are represented here, the Suggested Lakota Orthography -and what is known as the White Hat Orthography. Input methods lakota-slo-prefix, -lakota-slo-postfix, and lakota-white-hat-postfix have been added. -There is also a Lakota greeting in "etc/HELLO". +Two orthographies are represented here, the Suggested Lakota +Orthography and what is known as the White Hat Orthography. Input +methods 'lakota-slo-prefix', 'lakota-slo-postfix', and +'lakota-white-hat-postfix' have been added. There is also a Lakota +greeting in "etc/HELLO". ** Ispell @@ -2137,7 +2138,7 @@ Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text. +++ *** ERT can now output more verbose test failure reports. -If the EMACS_TEST_VERBOSE environment variable is set, failure +If the 'EMACS_TEST_VERBOSE' environment variable is set, failure summaries will include the failing condition. ** Miscellaneous @@ -2148,7 +2149,7 @@ This can be used to transform (and suppress) strings from entering the kill ring. --- -*** `C-u M-x dig' will now prompt for a query type to use. +*** 'C-u M-x dig' will now prompt for a query type to use. +++ *** rcirc now supports SASL authentication. @@ -2592,10 +2593,6 @@ GPG key servers can now be queried for keys with the 'M-x epa-search-keys' command. Keys can then be added to your personal key ring. -+++ -** Function 'lm-maintainer' was replaced with 'lm-maintainers'. -The former is now declared obsolete. - * New Modes and Packages in Emacs 28.1 @@ -2905,6 +2902,10 @@ These variables describe facts about the SQL standard and product-specific additions. There should be no need for users to customize them. +--- +** Function 'lm-maintainer' is replaced with 'lm-maintainers'. +The former is now declared obsolete. + * Lisp Changes in Emacs 28.1 @@ -3078,7 +3079,7 @@ been added, and takes a callback to handle the return status. +++ ** New function 'file-name-with-extension'. This function allows a canonical way to set/replace the extension of a -filename string. +file name. +++ ** New function 'file-backup-file-names'. diff --git a/lisp/files.el b/lisp/files.el index 39f4ca65b1..859c193db9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1011,7 +1011,7 @@ Any directory whose name matches this regexp will be treated like a kind of root directory by `locate-dominating-file', which will stop its search when it bumps into it. The default regexp prevents fruitless and time-consuming attempts to find -special files in directories in which filenames are interpreted as hostnames, +special files in directories in which file names are interpreted as host names, or mount points potentially requiring authentication as a different user.") (defun locate-dominating-file (file name) @@ -2959,7 +2959,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.xmp\\'" . image-mode) ("\\.xwd\\'" . image-mode) ("\\.yuv\\'" . image-mode))) - "Alist of filename patterns vs corresponding major mode functions. + "Alist of file name patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). \(NON-NIL stands for anything that is not nil; the value does not matter.) Visiting a file whose name matches REGEXP specifies FUNCTION as the @@ -3152,7 +3152,7 @@ To find the right major mode, this function checks for a -*- mode tag checks for a `mode:' entry in the Local Variables section of the file, checks if it uses an interpreter listed in `interpreter-mode-alist', matches the buffer beginning against `magic-mode-alist', -compares the filename against the entries in `auto-mode-alist', +compares the file name against the entries in `auto-mode-alist', then matches the buffer beginning against `magic-fallback-mode-alist'. If `enable-local-variables' is nil, or if the file name matches @@ -4901,8 +4901,8 @@ The extension (in a file name) is the part that begins with the last \".\". Trims a leading dot from the EXTENSION so that either \"foo\" or \".foo\" can be given. -Errors if the filename or extension are empty, or if the given -filename has the format of a directory. +Errors if the FILENAME or EXTENSION are empty, or if the given +FILENAME has the format of a directory. See also `file-name-sans-extension'." (let ((extn (string-trim-left extension "[.]"))) @@ -4941,7 +4941,7 @@ See also `backup-directory-alist'." (function :tag "Function"))) (defcustom backup-directory-alist nil - "Alist of filename patterns and backup directory names. + "Alist of file name patterns and backup directory names. Each element looks like (REGEXP . DIRECTORY). Backups of files with names matching REGEXP will be made in DIRECTORY. DIRECTORY may be relative or absolute. If it is absolute, so that all matching files @@ -4954,7 +4954,7 @@ For the common case of all backups going into one directory, the alist should contain a single element pairing \".\" with the appropriate directory name. -If this variable is nil, or it fails to match a filename, the backup +If this variable is nil, or it fails to match a file name, the backup is made in the original file's directory. On MS-DOS filesystems without long names this variable is always @@ -6780,7 +6780,7 @@ See also `make-auto-save-file-name'." (defun wildcard-to-regexp (wildcard) "Given a shell file name pattern WILDCARD, return an equivalent regexp. -The generated regexp will match a filename only if the filename +The generated regexp will match a file name only if the file name matches that wildcard according to shell rules. Only wildcards known by `sh' are supported." (let* ((i (string-match "[[.*+\\^$?]" wildcard)) @@ -7500,7 +7500,7 @@ If the current frame has no client, kill Emacs itself using With prefix ARG, silently save all file-visiting buffers, then kill. -If emacsclient was started with a list of filenames to edit, then +If emacsclient was started with a list of file names to edit, then only these files will be asked to be saved." (interactive "P") (if (frame-parameter nil 'client) commit 8ebd8e1fea1d0d925850db97b64bf13a6a1f698b Author: Jonas Bernoulli Date: Wed Jun 30 22:17:01 2021 +0200 In files that use allout use it for all headings * lisp/allout.el: Don't prefix regular comments with three semicolons. * lisp/icomplete.el: Use allout syntax for all headings. * lisp/net/eudc.el: Use allout syntax for all headings. diff --git a/lisp/allout.el b/lisp/allout.el index 1605ce2ce3..0625ea68ab 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -2490,10 +2490,10 @@ We skip anomalous low-level topics, a la `allout-aberrant-container-p'." ;;;_ - Subtree Charting ;;;_ " These routines either produce or assess charts, which are -;;; nested lists of the locations of topics within a subtree. -;;; -;;; Charts enable efficient subtree navigation by providing a reusable basis -;;; for elaborate, compound assessment and adjustment of a subtree. +;; nested lists of the locations of topics within a subtree. +;; +;; Charts enable efficient subtree navigation by providing a reusable basis +;; for elaborate, compound assessment and adjustment of a subtree. ;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth) (defun allout-chart-subtree (&optional levels visible orig-depth prev-depth) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 08b4ef2030..26698c43cf 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -276,8 +276,8 @@ Last entry becomes the first and can be selected with (setcdr last-but-one (cdr (cdr last-but-one))))) (completion--cache-all-sorted-completions beg end comps))) -;;; Helpers for `fido-mode' (or `ido-mode' emulation) -;;; +;;;_* Helpers for `fido-mode' (or `ido-mode' emulation) + (defun icomplete-fido-kill () "Kill line or current completion, like `ido-mode'. If killing to the end of line make sense, call `kill-line', @@ -966,7 +966,7 @@ matches exist." ;; is cached. (if last (setcdr last base-size)))))))) -;;; Iswitchb compatibility +;;;_* Iswitchb compatibility ;; We moved Iswitchb to `obsolete' in 24.4, but autoloads in files in ;; `obsolete' aren't obeyed (since that would encourage people to keep using @@ -981,7 +981,7 @@ matches exist." (provide 'icomplete) -;;_* Local emacs vars. +;;;_* Local emacs vars. ;;Local variables: ;;allout-layout: (-2 :) ;;End: diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 425217cf65..6459c52afe 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1129,7 +1129,9 @@ queries the server for the existing fields and displays a corresponding form." (cons "Directory Servers" (easy-menu-create-menu "Directory Servers" (cdr (eudc-menu)))))) -;;; Load time initializations : +;;}}} + +;;{{{ Load time initializations ;; Load the options file (if (and (not noninteractive) commit ecec94dcf0ebeab39dc7949797b34a559f7eb266 Author: Jonas Bernoulli Date: Wed Jun 30 22:15:13 2021 +0200 * lisp/comint.el: Prefix headings with enough semicolons. Outline headings must begin with three or more semicolons. diff --git a/lisp/comint.el b/lisp/comint.el index ef34174305..9e406614b9 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -54,7 +54,7 @@ ;; instead of shell-mode, see the notes at the end of this file. -;; Brief Command Documentation: +;;; Brief Command Documentation: ;;============================================================================ ;; Comint Mode Commands: (common to all derived modes, like shell & cmulisp ;; mode) @@ -106,7 +106,7 @@ (require 'regexp-opt) ;For regexp-opt-charset. (eval-when-compile (require 'subr-x)) -;; Buffer Local Variables: +;;; Buffer Local Variables: ;;============================================================================ ;; Comint mode buffer local variables: ;; comint-prompt-regexp string comint-bol uses to match prompt @@ -150,10 +150,10 @@ :group 'comint) ;; Unused. -;;; (defgroup comint-source nil -;;; "Source finding facilities in comint." -;;; :prefix "comint-" -;;; :group 'comint) +;; (defgroup comint-source nil +;; "Source finding facilities in comint." +;; :prefix "comint-" +;; :group 'comint) (defvar comint-prompt-regexp "^" "Regexp to recognize prompts in the inferior process. @@ -924,8 +924,8 @@ by the global keymap (usually `mouse-yank-at-click')." ;; Insert the input at point (insert input))))) -;; Input history processing in a buffer -;; =========================================================================== +;;; Input history processing in a buffer +;;============================================================================ ;; Useful input history functions, courtesy of the Ergo group. ;; Eleven commands: @@ -2847,7 +2847,7 @@ updated using `comint-update-fence', if necessary." (kill-region beg end) (comint-update-fence)))))) -;; Support for source-file processing commands. +;;; Support for source-file processing commands. ;;============================================================================ ;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have ;; commands that process files of source text (e.g. loading or compiling @@ -2981,8 +2981,8 @@ A typical use: ;; -Olin -;; Simple process query facility. -;; =========================================================================== +;;; Simple process query facility. +;;============================================================================ ;; This function is for commands that want to send a query to the process ;; and show the response to the user. For example, a command to get the ;; arglist for a Common Lisp function might send a "(arglist 'foo)" query @@ -3018,8 +3018,8 @@ its response can be seen." (set-window-point proc-win opoint))))))) -;; Filename/command/history completion in a buffer -;; =========================================================================== +;;; Filename/command/history completion in a buffer +;;============================================================================ ;; Useful completion functions, courtesy of the Ergo group. ;; Six commands: @@ -3883,8 +3883,8 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." (forward-line 1))) (nreverse results)))) -;; Converting process modes to use comint mode -;; =========================================================================== +;;; Converting process modes to use comint mode +;;============================================================================ ;; The code in the Emacs 19 distribution has all been modified to use comint ;; where needed. However, there are `third-party' packages out there that ;; still use the old shell mode. Here's a guide to conversion. commit 1a00bf16a72b03c9d79ec3bd301d02efc94f9683 Author: Jonas Bernoulli Date: Sun Mar 14 20:24:07 2021 +0100 Improve consistency of outline headings in dired libraries * lisp/dired-aux.el: Improve consistency of outline headings. * lisp/dired-x.el: Improve consistency of outline headings. * lisp/dired.el: Improve consistency of outline headings. - Use three semicolons at beginning of headings because that already is the dominant number of semicolons for headings in these files. - Prefix each heading with a ^L instead of randomly omitting it in front of some. - Always prefix the line with the ^L with a completely empty line. - Begin headings with a capital letter. - Do not update complete headings. - Do not end headings with a period. - Remove a handful of section end markers. - Address further inconsistencies. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 73bceffbc2..060f3a8411 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -33,6 +33,7 @@ ;; sorting by Sebastian Kremer . ;; Finished up by rms in 1992. + ;;; Code: (require 'cl-lib) @@ -45,9 +46,8 @@ Functions that operate recursively can store additional names into this list; they also should call `dired-log' to log the errors.") -;;; 15K -;;;###begin dired-cmd.el -;; Diffing and compressing + +;;; Diffing and compressing (defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)") (defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)") @@ -418,6 +418,7 @@ List has a form of (file-name full-file-name (attribute-list))." full-file-name (file-attributes full-file-name)))) (directory-files dir))) + ;;; Change file attributes @@ -655,8 +656,9 @@ passed as the second arg to `completing-read'." 'completing-read (format prompt (dired-mark-prompt arg files)) collection nil nil initial nil default-value nil)) + -;;; Cleaning a directory: flagging some backups for deletion. +;;; Cleaning a directory: flagging some backups for deletion (defvar dired-file-version-alist) @@ -699,7 +701,8 @@ with a prefix argument." (dired-map-dired-file-lines #'dired-trample-file-versions) (message "Cleaning numerical backups...done"))) -;;; Subroutines of dired-clean-directory. + +;;; Subroutines of dired-clean-directory (defun dired-map-dired-file-lines (fun) ;; Perform FUN with point at the end of each non-directory line. @@ -750,6 +753,7 @@ with a prefix argument." (progn (beginning-of-line) (delete-char 1) (insert dired-del-marker))))) + ;;; Shell commands @@ -986,8 +990,8 @@ prompted for the shell command to use interactively." (shell-command command))) ;; Return nil for sake of nconc in dired-bunch-files. nil) - + (defun dired-check-process (msg program &rest arguments) "Display MSG while running PROGRAM, and check for output. Remaining arguments are strings passed as command arguments to PROGRAM. @@ -1032,8 +1036,9 @@ Return the result of `process-file' - zero for success." (unless (zerop res) (pop-to-buffer out-buffer)) res)))) + -;; Commands that delete or redisplay part of the dired buffer. +;;; Commands that delete or redisplay part of the dired buffer (defun dired-kill-line (&optional arg) "Kill the current line (not the files). @@ -1098,10 +1103,8 @@ present. A FMT of \"\" will suppress the messaging." (message (or fmt "Killed %d line%s.") count (dired-plural-s count))) count)))) -;;;###end dired-cmd.el -;;; 30K -;;;###begin dired-cp.el +;;; Compression (defun dired-compress () ;; Compress or uncompress the current file. @@ -1454,7 +1457,8 @@ uncompress and unpack all the files in the archive." (interactive "P") (dired-map-over-marks-check #'dired-compress arg 'compress t)) -;; Commands for Emacs Lisp files - load and byte compile + +;;; Commands for Emacs Lisp files - load and byte compile (defun dired-byte-compile () ;; Return nil for success, offending file name else. @@ -1546,6 +1550,7 @@ See Info node `(emacs)Subdir switches' for more details." (interactive) (setq dired-switches-alist nil) (revert-buffer)) + (defun dired-update-file-line (file) ;; Delete the current line, and insert an entry for FILE. @@ -1734,6 +1739,7 @@ See `dired-delete-file' in case you wish that." (line-beginning-position 2))) (setq file (directory-file-name file)) (dired-add-entry file (if (eq ?\s marker) nil marker))))) + ;;; Copy, move/rename, making hard and symbolic links @@ -1933,7 +1939,9 @@ unless OK-IF-ALREADY-EXISTS is non-nil." (defvar overwrite-query) (defvar overwrite-backup-query) -;; The basic function for half a dozen variations on cp/mv/ln/ln -s. + +;;; The basic function for half a dozen variations on cp/mv/ln/ln -s + (defun dired-create-files (file-creator operation fn-list name-constructor &optional marker-char) "Create one or more new files from a list of existing files FN-LIST. @@ -2067,6 +2075,7 @@ ESC or `q' to not overwrite any of the remaining files, success-count) operation success-count)))) (dired-move-to-filename)) + (defcustom dired-do-revert-buffer nil "Automatically revert Dired buffers after `dired-do' operations. @@ -2299,7 +2308,6 @@ Optional arg HOW-TO determines how to treat the target. dired-dirs))) - ;; We use this function in `dired-create-directory' and ;; `dired-create-empty-file'; the return value is the new entry ;; in the updated Dired buffer. @@ -2448,10 +2456,10 @@ of `dired-dwim-target', which see." (interactive "P") (dired-do-create-files 'move #'dired-rename-file "Move" arg dired-keep-marker-rename "Rename")) -;;;###end dired-cp.el + -;;; 5K -;;;###begin dired-re.el +;;; Operate on files matched by regexp + (defvar rename-regexp-query) (defun dired-do-create-files-regexp @@ -2572,6 +2580,9 @@ See function `dired-do-rename-regexp' for more info." #'make-symbolic-link "SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) + +;;; Change case of file names + (defvar rename-non-directory-query) (defun dired-create-files-non-directory @@ -2617,10 +2628,8 @@ Type SPC or `y' to %s one file, DEL or `n' to skip to next, (interactive "P") (dired-rename-non-directory #'downcase "Rename downcase" arg)) -;;;###end dired-re.el -;;; 13K -;;;###begin dired-ins.el +;;; Insert subdirectory ;;;###autoload (defun dired-maybe-insert-subdir (dirname &optional @@ -2894,8 +2903,9 @@ is always equal to STRING." (setq result (cons (substring str end) result))) (nreverse result))) + -;;; moving by subdirectories +;;; Moving by subdirectories ;;;###autoload (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip) @@ -2998,8 +3008,9 @@ Lower levels are unaffected." (if pos (goto-char pos) (error "At the bottom")))) + -;;; hiding +;;; Hiding ;;;###autoload (defun dired-hide-subdir (arg) @@ -3043,10 +3054,8 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." (dired--hide start end)) (setq pos (cdr subdir))))))) ; prev dir gets current dir -;;;###end dired-ins.el - -;; Search only in file names in the Dired buffer. +;;; Search only in file names in the Dired buffer (defcustom dired-isearch-filenames nil "Non-nil to Isearch in file names only. @@ -3116,7 +3125,7 @@ is part of a file name (i.e., has the text property `dired-filename')." (isearch-forward-regexp nil t)) -;; Functions for searching in tags style among marked files. +;;; Functions for searching in tags style among marked files ;;;###autoload (defun dired-do-isearch () diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 38a624fa72..8d99d1a21c 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -44,7 +44,8 @@ ;; but maybe not if a dired-x function is being autoloaded. (require 'dired) -;;; User-defined variables. + +;;; User-defined variables (defgroup dired-x nil "Extended directory editing (dired-x)." @@ -217,7 +218,9 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." :type 'boolean :group 'dired-x) -;;; KEY BINDINGS. + +;;; Key bindings + (when (keymapp (lookup-key dired-mode-map "*")) (define-key dired-mode-map "*(" 'dired-mark-sexp) (define-key dired-mode-map "*O" 'dired-mark-omitted) @@ -234,7 +237,8 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." (define-key dired-mode-map "Y" 'dired-do-relsymlink) (define-key dired-mode-map "V" 'dired-do-run-mail) -;;; MENU BINDINGS + +;;; Menu bindings (when-let ((menu (lookup-key dired-mode-map [menu-bar]))) (easy-menu-add-item menu '("Operate") @@ -274,7 +278,7 @@ files"] "Refresh")) -;; Install into appropriate hooks. +;;; Install into appropriate hooks (add-hook 'dired-mode-hook 'dired-extra-startup) (add-hook 'dired-after-readin-hook 'dired-omit-expunge) @@ -303,7 +307,7 @@ See also the functions: (dired-omit-startup)) -;;; EXTENSION MARKING FUNCTIONS. +;;; Extension marking functions (defun dired--mark-suffix-interactive-spec () (let* ((default @@ -432,7 +436,7 @@ See variables `dired-texinfo-unclean-extensions', (list ".dvi")))) -;;; OMITTING. +;;; Omitting ;; Enhanced omitting of lines from directory listings. ;; Marked files are never omitted. @@ -570,7 +574,7 @@ files in the active region if `dired-mark-region' is non-nil." msg))) -;;; VIRTUAL DIRED MODE. +;;; Virtual dired mode ;; For browsing `ls -lR' listings in a dired-like fashion. @@ -693,7 +697,7 @@ Also useful for `auto-mode-alist' like this: (dired-virtual (dired-virtual-guess-dir))) -;;; SMART SHELL. +;;; Smart shell ;; An Emacs buffer can have but one working directory, stored in the ;; buffer-local variable `default-directory'. A Dired buffer may have @@ -720,7 +724,7 @@ Also useful for `auto-mode-alist' like this: (shell-command command output-buffer error-buffer))) -;;; GUESS SHELL COMMAND. +;;; Guess shell command ;; Brief Description: ;; @@ -1028,7 +1032,7 @@ See `dired-guess-shell-alist-user'." (if (equal val "") default val)))) -;;; RELATIVE SYMBOLIC LINKS. +;;; Relative symbolic links (declare-function make-symbolic-link "fileio.c") @@ -1117,7 +1121,7 @@ for more info." "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink)) -;;; VISIT ALL MARKED FILES SIMULTANEOUSLY. +;;; Visit all marked files simultaneously ;; Brief Description: ;; @@ -1186,7 +1190,7 @@ NOSELECT the files are merely found but not selected." (find-file file))))) -;;; MISCELLANEOUS COMMANDS. +;;; Miscellaneous commands ;; Run man on files. @@ -1254,7 +1258,7 @@ otherwise." (dired-rmail))))) -;;; MISCELLANEOUS INTERNAL FUNCTIONS. +;;; Miscellaneous internal functions ;; This should be a builtin (defun dired-buffer-more-recently-used-p (buffer1 buffer2) @@ -1264,7 +1268,6 @@ Considers buffers closer to the car of `buffer-list' to be more recent." (memq buffer1 (buffer-list)) (not (memq buffer1 (memq buffer2 (buffer-list)))))) - ;; Needed if ls -lh is supported and also for GNU ls -ls. (defun dired-x--string-to-number (str) "Like `string-to-number' but recognize a trailing unit prefix. @@ -1437,7 +1440,7 @@ only in the active region if `dired-mark-region' is non-nil." (format "'%s file" predicate)))) -;;; FIND FILE AT POINT. +;;; Find file at point (defcustom dired-x-hands-off-my-keys t "Non-nil means don't remap `find-file' to `dired-x-find-file'. @@ -1484,7 +1487,8 @@ a prefix argument, when it offers the filename near point as a default." (interactive (list (dired-x-read-filename-at-point "Find file: "))) (find-file-other-window filename)) -;;; Internal functions. + +;;; Internal functions ;; Fixme: This should probably use `thing-at-point'. -- fx (define-obsolete-function-alias 'dired-filename-at-point @@ -1532,8 +1536,9 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." (define-obsolete-function-alias 'read-filename-at-point 'dired-x-read-filename-at-point "24.1") ; is this even needed? + -;;; BUG REPORTS +;;; Epilog (define-obsolete-function-alias 'dired-x-submit-report 'report-emacs-bug "24.1") diff --git a/lisp/dired.el b/lisp/dired.el index 1f9037180d..9ddd2c542d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -41,6 +41,7 @@ (declare-function dired-buffer-more-recently-used-p "dired-x" (buffer1 buffer2)) + ;;; Customizable variables (defgroup dired nil @@ -254,8 +255,6 @@ This is similar to the \"-L\" option for the \"cp\" shell command." (define-obsolete-variable-alias 'dired-free-space-args 'directory-free-space-args "27.1") -;;; Hook variables - (defcustom dired-load-hook nil "Run after loading Dired. You can customize key bindings or load extensions with this." @@ -357,7 +356,8 @@ is anywhere on its Dired line, except the beginning of the line." :group 'dired :version "28.1") -;; Internal variables + +;;; Internal variables (defvar dired-marker-char ?* ; the answer is 42 ;; so that you can write things like @@ -457,6 +457,9 @@ The match starts at the beginning of the line and ends after the end of the line. Subexpression 2 must end right before the \\n.") + +;;; Faces + (defgroup dired-faces nil "Faces used by Dired." :group 'dired @@ -560,6 +563,9 @@ Subexpression 2 must end right before the \\n.") (defvar dired-ignored-face 'dired-ignored "Face name used for files suffixed with `completion-ignored-extensions'.") + +;;; Font-lock + (defvar dired-font-lock-keywords (list ;; @@ -687,8 +693,11 @@ Subexpression 2 must end right before the \\n.") "Additional expressions to highlight in Dired mode.") (defvar dnd-protocol-alist) + -;;; Macros must be defined before they are used, for the byte compiler. +;;; Macros + +;; Macros must be defined before they are used, for the byte compiler. (defmacro dired-mark-if (predicate msg) "Mark files for PREDICATE, according to `dired-marker-char'. @@ -883,7 +892,7 @@ ERROR can be a string with the error message." (point-max))) -;; The dired command +;;; The dired command (defun dired-read-dir-and-switches (str) ;; For use in interactive. @@ -1263,7 +1272,7 @@ The return value is the target column for the file names." found))) -;; Read in a new dired buffer +;;; Read in a new dired buffer (defun dired-readin () "Read in a new Dired buffer. @@ -1627,8 +1636,9 @@ see `dired-use-ls-dired' for more details.") (put-text-property (+ (point) 4) (line-end-position) 'invisible 'dired-hide-details-link)))) (forward-line 1)))) + -;; Reverting a dired buffer +;;; Reverting a dired buffer (defun dired-revert (&optional _arg _noconfirm) "Reread the Dired buffer. @@ -1815,8 +1825,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (let ((handler (find-file-name-handler dir 'dired-uncache))) (if handler (funcall handler 'dired-uncache dir)))) + -;; dired mode key bindings and initialization +;;; Dired mode key bindings and menus (defvar dired-mode-map ;; This looks ugly when substitute-command-keys uses C-d instead d: @@ -2177,6 +2188,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." :help "Delete image tag from current or marked files"])) +;;; Dired mode + ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) @@ -2274,8 +2287,9 @@ Keybindings: (add-hook 'file-name-at-point-functions #'dired-file-name-at-point nil t) (add-hook 'isearch-mode-hook #'dired-isearch-filenames-setup nil t) (run-mode-hooks 'dired-mode-hook)) + -;; Idiosyncratic dired commands that don't deal with marks. +;;; Idiosyncratic dired commands that don't deal with marks (defun dired-summary () "Summarize basic Dired commands and show recent Dired errors." @@ -2473,8 +2487,9 @@ Otherwise, display it in another buffer." (interactive) (display-buffer (find-file-noselect (dired-get-file-for-visit)) t)) + -;;; Functions for extracting and manipulating file names in Dired buffers. +;;; Functions for extracting and manipulating file names in Dired buffers (defun dired-unhide-subdir () (with-silent-modifications @@ -2619,7 +2634,10 @@ unchanged." (if (string-match (concat "^" (regexp-quote dir)) file) (substring file (match-end 0)) file)) + +;;; Mode to hide details + (define-minor-mode dired-hide-details-mode "Toggle visibility of detailed information in current Dired buffer. When this minor mode is enabled, details such as file ownership and @@ -2656,6 +2674,7 @@ See options: `dired-hide-details-hide-symlink-targets' and 'add-to-invisibility-spec 'remove-from-invisibility-spec) 'dired-hide-details-link)) + ;;; Functions to hide/unhide text @@ -2685,7 +2704,7 @@ See options: `dired-hide-details-hide-symlink-targets' and (progn (goto-char end) (line-end-position)) '(invisible)))) -;;; Functions for finding the file name in a dired buffer line. +;;; Functions for finding the file name in a dired buffer line (defvar dired-permission-flags-regexp "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)" @@ -2784,7 +2803,7 @@ If EOL, it should be an position to use instead of (point))))) -;;; COPY NAMES OF MARKED FILES INTO KILL-RING. +;;; Copy names of marked files into kill-ring (defun dired-copy-filename-as-kill (&optional arg) "Copy names of marked (or next ARG) files into the kill ring. @@ -2818,7 +2837,7 @@ You can then feed the file name(s) to other commands with \\[yank]." (message "%s" string)))) -;; Keeping Dired buffers in sync with the filesystem and with each other +;;; Keeping Dired buffers in sync with the filesystem and with each other (defun dired-buffers-for-dir (dir &optional file subdirs) "Return a list of buffers for DIR (top level or in-situ subdir). @@ -2904,10 +2923,9 @@ dired-buffers." ;; Removing is also done as a side-effect in dired-buffer-for-dir. (setq dired-buffers (delq (assoc (expand-file-name dir) dired-buffers) dired-buffers))) - -;; Tree Dired -;;; utility functions + +;;; Utility functions (defun dired-in-this-tree-p (file dir) ;;"Is FILE part of the directory tree starting at DIR?" @@ -3167,7 +3185,7 @@ It runs the hook `dired-initial-position-hook'." (dired-goto-subdir dirname)) (if dired-trivial-filenames (dired-goto-next-nontrivial-file)) (run-hooks 'dired-initial-position-hook)) - + ;; These are hooks which make tree dired work. ;; They are in this file because other parts of dired need to call them. ;; But they don't call the rest of tree dired unless there are subdirs loaded. @@ -3206,8 +3224,9 @@ is the directory where the file on this line resides." (if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t))) (point-max) (point)))) + -;; Deleting files +;;; Deleting files (defcustom dired-recursive-deletes 'top "Whether Dired deletes directories recursively. @@ -3448,7 +3467,7 @@ confirmation. To disable the confirmation, see (kill-buffer buf)))))) -;; Confirmation +;;; Confirmation (defun dired-marker-regexp () (concat "^" (regexp-quote (char-to-string dired-marker-char)))) @@ -3567,8 +3586,9 @@ argument or confirmation)." (let ((beg (point))) (completion--insert-strings files) (put-text-property beg (point) 'mouse-face nil))) + -;; Commands to mark or flag file(s) at or near current line. +;;; Commands to mark or flag file(s) at or near current line (defun dired-repeat-over-lines (arg function) ;; This version skips non-file lines. @@ -3756,8 +3776,9 @@ on the whole buffer." (list ?\s dired-marker-char) (list dired-marker-char ?\s)))) (forward-line 1))))) + -;;; Commands to mark or flag files based on their characteristics or names. +;;; Commands to mark or flag files based on their characteristics or names (defvar dired-regexp-history nil "History list of regular expressions used in Dired commands.") @@ -4033,8 +4054,9 @@ Type SPC or `y' to unmark one file, DEL or `n' to skip to next, (message (if (= count 1) "1 mark removed" "%d marks removed") count)))) + -;; Logging failures operating on files, and showing the results. +;;; Logging failures operating on files, and showing the results (defvar dired-log-buffer "*Dired log*") @@ -4099,6 +4121,7 @@ or nil if file names are not applicable." ;; Log a summary describing a bunch of errors. (dired-log (concat "\n" string "\n")) (dired-log t)) + ;;; Sorting @@ -4280,9 +4303,9 @@ To be called first in body of `dired-sort-other', etc." ;; No pre-R subdir alist, so revert to main directory ;; listing: (list (car (reverse dired-subdir-alist)))))))) - -;;;; Drag and drop support + +;;; Drag and drop support (defcustom dired-recursive-copies 'top "Whether Dired copies directories recursively. @@ -4384,9 +4407,9 @@ Ask means pop up a menu for the user to select one of copy, move or link." (let ((local-file (dnd-get-local-file-uri uri))) (if local-file (dired-dnd-handle-local-file local-file action) nil))) - -;;;; Desktop support + +;;; Desktop support (eval-when-compile (require 'desktop)) (declare-function desktop-file-name "desktop" (filename dirname)) @@ -4432,7 +4455,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." '(dired-mode . dired-restore-desktop-buffer)) -;;;; Jump to Dired +;;; Jump to Dired (defvar archive-superior-buffer) (defvar tar-superior-buffer) commit 1b1c4ef3cba235a97c424da4bc7ccfafea5b4bf8 Author: Jonas Bernoulli Date: Wed Jun 30 20:10:30 2021 +0200 Cleanup whitespace and comments in dired libraries * lisp/dired-aux.el: Cleanup whitespace and comments. * lisp/dired-x.el: Cleanup whitespace and comments. * lisp/dired.el: Cleanup whitespace and comments. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d002d1fa90..73bceffbc2 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -135,7 +135,7 @@ substituted, and will be passed through normally to the shell. %s -(Press ^ to %s markers below these occurrences.) +\(Press ^ to %s markers below these occurrences.) " "`" (string (aref command (car char-positions))) @@ -288,12 +288,12 @@ If this file is a backup, diff it with its original. The backup file is the first file given to `diff'. With prefix arg, prompt for argument SWITCHES which is options for `diff'." (interactive - (if current-prefix-arg - (list (read-string "Options for diff: " - (if (stringp diff-switches) - diff-switches - (mapconcat #'identity diff-switches " ")))) - nil)) + (if current-prefix-arg + (list (read-string "Options for diff: " + (if (stringp diff-switches) + diff-switches + (mapconcat #'identity diff-switches " ")))) + nil)) (diff-backup (dired-get-filename) switches)) ;;;###autoload @@ -636,7 +636,7 @@ Uses the shell command coming from variables `lpr-command' and (dired-run-shell-command (dired-shell-stuff-it command file-list nil)))) (defun dired-mark-read-string (prompt initial op-symbol arg files - &optional default-value collection) + &optional default-value collection) "Read args for a Dired marked-files command, prompting with PROMPT. Return the user input (a string). @@ -871,8 +871,8 @@ can be produced by `dired-get-marked-files', for example. `dired-guess-shell-alist-default' and `dired-guess-shell-alist-user' are consulted when the user is prompted for the shell command to use interactively." -;;Functions dired-run-shell-command and dired-shell-stuff-it do the -;;actual work and can be redefined for customization. + ;; Functions dired-run-shell-command and dired-shell-stuff-it do the + ;; actual work and can be redefined for customization. (interactive (let ((files (dired-get-marked-files t current-prefix-arg nil nil t))) (list @@ -914,13 +914,13 @@ prompted for the shell command to use interactively." "Separates marked files in dired shell commands.") (defun dired-shell-stuff-it (command file-list on-each &optional _raw-arg) -;; "Make up a shell command line from COMMAND and FILE-LIST. -;; If ON-EACH is t, COMMAND should be applied to each file, else -;; simply concat all files and apply COMMAND to this. -;; FILE-LIST's elements will be quoted for the shell." -;; Might be redefined for smarter things and could then use RAW-ARG -;; (coming from interactive P and currently ignored) to decide what to do. -;; Smart would be a way to access basename or extension of file names. + ;; "Make up a shell command line from COMMAND and FILE-LIST. + ;; If ON-EACH is t, COMMAND should be applied to each file, else + ;; simply concat all files and apply COMMAND to this. + ;; FILE-LIST's elements will be quoted for the shell." + ;; Might be redefined for smarter things and could then use RAW-ARG + ;; (coming from interactive P and currently ignored) to decide what to do. + ;; Smart would be a way to access basename or extension of file names. (let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command)) (command (if in-background (substring command 0 (match-beginning 0)) @@ -1382,19 +1382,19 @@ see `dired-compress-file-alist' for the supported suffixes list." (dired-mark-prompt arg files) "? "))))) (defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress) -; "Map FUN over marked files (with second ARG like in dired-map-over-marks) -; and display failures. + ;; "Map FUN over marked files (with second ARG like in dired-map-over-marks) + ;; and display failures. -; FUN takes zero args. It returns non-nil (the offending object, e.g. -; the short form of the filename) for a failure and probably logs a -; detailed error explanation using function `dired-log'. + ;; FUN takes zero args. It returns non-nil (the offending object, e.g. + ;; the short form of the filename) for a failure and probably logs a + ;; detailed error explanation using function `dired-log'. -; OP-SYMBOL is a symbol describing the operation performed (e.g. -; `compress'). It is used with `dired-mark-pop-up' to prompt the user -; (e.g. with `Compress * [2 files]? ') and to display errors (e.g. -; `Failed to compress 1 of 2 files - type W to see why ("foo")') + ;; OP-SYMBOL is a symbol describing the operation performed (e.g. + ;; `compress'). It is used with `dired-mark-pop-up' to prompt the user + ;; (e.g. with `Compress * [2 files]? ') and to display errors (e.g. + ;; `Failed to compress 1 of 2 files - type W to see why ("foo")') -; SHOW-PROGRESS if non-nil means redisplay dired after each file." + ;; SHOW-PROGRESS if non-nil means redisplay dired after each file." (if (dired-mark-confirm op-symbol arg) (let* ((total-list;; all of FUN's return values (dired-map-over-marks (funcall fun) arg show-progress)) @@ -1486,7 +1486,7 @@ uncompress and unpack all the files in the archive." ;; Return nil for success, offending file name else. (let ((file (dired-get-filename)) failure) (condition-case err - (load file nil nil t) + (load file nil nil t) (error (setq failure err))) (if (not failure) nil @@ -1700,7 +1700,7 @@ files matching `dired-omit-regexp'." (forward-line 1) (while (and (not (eolp)) ; don't cross subdir boundary (not (dired-move-to-filename))) - (forward-line 1)) + (forward-line 1)) (point))) ;;;###autoload @@ -2415,7 +2415,7 @@ suggested for the target directory depends on the value of For relative symlinks, use \\[dired-do-relsymlink]." (interactive "P") (dired-do-create-files 'symlink #'make-symbolic-link - "Symlink" arg dired-keep-marker-symlink)) + "Symlink" arg dired-keep-marker-symlink)) ;;;###autoload (defun dired-do-hardlink (&optional arg) @@ -2428,7 +2428,7 @@ suggested for the target directory depends on the value of `dired-dwim-target', which see." (interactive "P") (dired-do-create-files 'hardlink #'dired-hardlink - "Hardlink" arg dired-keep-marker-hardlink)) + "Hardlink" arg dired-keep-marker-hardlink)) (defun dired-hardlink (file newname &optional ok-if-already-exists) (dired-handle-overwrite newname) @@ -2455,7 +2455,7 @@ of `dired-dwim-target', which see." (defvar rename-regexp-query) (defun dired-do-create-files-regexp - (file-creator operation arg regexp newname &optional whole-name marker-char) + (file-creator operation arg regexp newname &optional whole-name marker-char) ;; Create a new file for each marked file using regexps. ;; FILE-CREATOR and OPERATION as in dired-create-files. ;; ARG as in dired-get-marked-files. @@ -2575,7 +2575,7 @@ See function `dired-do-rename-regexp' for more info." (defvar rename-non-directory-query) (defun dired-create-files-non-directory - (file-creator basename-constructor operation arg) + (file-creator basename-constructor operation arg) ;; Perform FILE-CREATOR on the non-directory part of marked files ;; using function BASENAME-CONSTRUCTOR, with query for each file. ;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 6619a39167..38a624fa72 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -623,7 +623,7 @@ you can relist single subdirs using \\[dired-do-redisplay]." (and (looking-at "^ wildcard ") (buffer-substring (match-end 0) (line-end-position)))))) - (if wildcard + (if wildcard (setq dirname (expand-file-name wildcard default-directory)))) ;; If raw ls listing (not a saved old dired buffer), give it a ;; decent subdir headerline: @@ -723,27 +723,27 @@ Also useful for `auto-mode-alist' like this: ;;; GUESS SHELL COMMAND. ;; Brief Description: -;;; +;; ;; * `dired-do-shell-command' is bound to `!' by dired.el. -;;; +;; ;; * `dired-guess-shell-command' provides smarter defaults for -;;; dired-aux.el's `dired-read-shell-command'. -;;; +;; dired-aux.el's `dired-read-shell-command'. +;; ;; * `dired-guess-shell-command' calls `dired-guess-default' with list of -;;; marked files. -;;; +;; marked files. +;; ;; * Parse `dired-guess-shell-alist-user' and -;;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP -;;; that matches the first file in the file list. -;;; +;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP +;; that matches the first file in the file list. +;; ;; * If the REGEXP matches all the entries of the file list then evaluate -;;; COMMAND, which is either a string or a Lisp expression returning a -;;; string. COMMAND may be a list of commands. -;;; +;; COMMAND, which is either a string or a Lisp expression returning a +;; string. COMMAND may be a list of commands. +;; ;; * Return this command to `dired-guess-shell-command' which prompts user -;;; with it. The list of commands is put into the list of default values. -;;; If a command is used successfully then it is stored permanently in -;;; `dired-shell-command-history'. +;; with it. The list of commands is put into the list of default values. +;; If a command is used successfully then it is stored permanently in +;; `dired-shell-command-history'. ;; Guess what shell command to apply to a file. (defvar dired-shell-command-history nil @@ -1089,7 +1089,7 @@ results in ;;;###autoload (defun dired-do-relsymlink (&optional arg) - "Relative symlink all marked (or next ARG) files into a directory. + "Relative symlink all marked (or next ARG) files into a directory. Otherwise make a relative symbolic link to the current file. This creates relative symbolic links like @@ -1102,7 +1102,7 @@ not absolute ones like For absolute symlinks, use \\[dired-do-symlink]." (interactive "P") (dired-do-create-files 'relsymlink #'dired-make-relative-symlink - "RelSymLink" arg dired-keep-marker-relsymlink)) + "RelSymLink" arg dired-keep-marker-relsymlink)) (autoload 'dired-mark-read-regexp "dired-aux") (autoload 'dired-do-create-files-regexp "dired-aux") @@ -1120,27 +1120,27 @@ for more info." ;;; VISIT ALL MARKED FILES SIMULTANEOUSLY. ;; Brief Description: -;;; +;; ;; `dired-do-find-marked-files' is bound to `F' by dired-x.el. -;;; +;; ;; * Use `dired-get-marked-files' to collect the marked files in the current -;;; Dired Buffer into a list of filenames `FILE-LIST'. -;;; +;; Dired Buffer into a list of filenames `FILE-LIST'. +;; ;; * Pass FILE-LIST to `dired-simultaneous-find-file' all with -;;; `dired-do-find-marked-files''s prefix argument NOSELECT. -;;; +;; `dired-do-find-marked-files''s prefix argument NOSELECT. +;; ;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the -;;; list each time. -;;; +;; list each time. +;; ;; * If NOSELECT is non-nil then just run `find-file-noselect' on each -;;; element of FILE-LIST. -;;; +;; element of FILE-LIST. +;; ;; * If NOSELECT is nil then calculate the `size' of the window for each file -;;; by dividing the `window-height' by length of FILE-LIST. Thus, `size' is -;;; cognizant of the window-configuration. -;;; +;; by dividing the `window-height' by length of FILE-LIST. Thus, `size' is +;; cognizant of the window-configuration. +;; ;; * If `size' is too small abort, otherwise run `find-file' on each element -;;; of FILE-LIST giving each a window of height `size'. +;; of FILE-LIST giving each a window of height `size'. (defun dired-do-find-marked-files (&optional noselect) "Find all marked files displaying all of them simultaneously. @@ -1196,8 +1196,8 @@ NOSELECT the files are merely found but not selected." (defun dired-man () "Run `man' on this file." -;; Used also to say: "Display old buffer if buffer name matches filename." -;; but I have no idea what that means. + ;; Used also to say: "Display old buffer if buffer name matches filename." + ;; but I have no idea what that means. (interactive) (require 'man) (let* ((file (dired-get-filename)) diff --git a/lisp/dired.el b/lisp/dired.el index bb428e2198..1f9037180d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -53,7 +53,6 @@ :prefix "dired-" :group 'dired) - ;;;###autoload (defcustom dired-listing-switches (purecopy "-al") "Switches passed to `ls' for Dired. MUST contain the `l' option. @@ -78,9 +77,9 @@ some of the `ls' switches are not supported; see the doc string of (defcustom dired-subdir-switches nil "If non-nil, switches passed to `ls' for inserting subdirectories. If nil, `dired-listing-switches' is used." - :group 'dired - :type '(choice (const :tag "Use dired-listing-switches" nil) - (string :tag "Switches"))) + :group 'dired + :type '(choice (const :tag "Use dired-listing-switches" nil) + (string :tag "Switches"))) (defcustom dired-maybe-use-globstar nil "If non-nil, enable globstar if the shell supports it. @@ -144,8 +143,8 @@ For more details, see Info node `(emacs)ls in Lisp'." (defcustom dired-touch-program "touch" "Name of touch command (usually `touch')." - :group 'dired - :type 'file) + :group 'dired + :type 'file) (defcustom dired-ls-F-marks-symlinks nil "Informs Dired about how `ls -lF' marks symbolic links. @@ -220,7 +219,7 @@ or the most recently used window with a Dired buffer, or to use any other function. When the value is a function, it will be called with no arguments and is expected to return a list of directories which will be used as defaults (i.e. default target and \"future history\") -(though, `dired-dwim-target-defaults' might modify it a bit). +\(though, `dired-dwim-target-defaults' might modify it a bit). The value t prefers the next windows on the same frame. The target is used in the prompt for file copy, rename etc." @@ -247,9 +246,9 @@ The target is used in the prompt for file copy, rename etc." This is similar to the \"-L\" option for the \"cp\" shell command." :type 'boolean :group 'dired) - ; -; These variables were deleted and the replacements are on files.el. -; We leave aliases behind for back-compatibility. + +;; These variables were deleted and the replacements are on files.el. +;; We leave aliases behind for back-compatibility. (define-obsolete-variable-alias 'dired-free-space-program 'directory-free-space-program "27.1") (define-obsolete-variable-alias 'dired-free-space-args @@ -376,8 +375,8 @@ This is what the do-commands look for, and what the mark-commands store.") "Character used to flag files for deletion.") (defvar dired-shrink-to-fit t -;; I see no reason ever to make this nil -- rms. -;; (> baud-rate search-slow-speed) + ;; I see no reason ever to make this nil -- rms. + ;; (> baud-rate search-slow-speed) "Non-nil means Dired shrinks the display buffer to fit the marked files.") (make-obsolete-variable 'dired-shrink-to-fit "use the Customization interface to add a new rule @@ -425,7 +424,7 @@ The directory name must be absolute, but need not be fully expanded.") "[bcsp][^:]")) (defvar dired-re-exe;; match ls permission string of an executable file (mapconcat (lambda (x) - (concat dired-re-maybe-mark dired-re-inode-size x)) + (concat dired-re-maybe-mark dired-re-inode-size x)) '("-[-r][-w][xs][-r][-w].[-r][-w]." "-[-r][-w].[-r][-w][xs][-r][-w]." "-[-r][-w].[-r][-w].[-r][-w][xst]") @@ -684,7 +683,7 @@ Subexpression 2 must end right before the \\n.") ;; ;; Directory headers. (list dired-subdir-regexp '(1 dired-header-face)) -) + ) "Additional expressions to highlight in Dired mode.") (defvar dnd-protocol-alist) @@ -1969,7 +1968,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ;; No need to do this, now that top-level items are fewer. ;;;; ;; Get rid of the Edit menu bar item to save space. - ;(define-key map [menu-bar edit] 'undefined) + ;;(define-key map [menu-bar edit] 'undefined) map) "Local keymap for Dired mode buffers.") @@ -2282,7 +2281,8 @@ Keybindings: "Summarize basic Dired commands and show recent Dired errors." (interactive) (dired-why) - ;>> this should check the key-bindings and use substitute-command-keys if non-standard + ;; FIXME this should check the key-bindings and use + ;; substitute-command-keys if non-standard (message "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp")) @@ -2581,7 +2581,7 @@ Otherwise, an error occurs in these cases." (concat (dired-current-directory localp) file))))) (defun dired-string-replace-match (regexp string newtext - &optional literal global) + &optional literal global) "Replace first match of REGEXP in STRING with NEWTEXT. If it does not match, nil is returned instead of the new string. Optional arg LITERAL means to take NEWTEXT literally. @@ -2592,7 +2592,7 @@ Optional arg GLOBAL means to replace all matches." (let ((from-end (- (length string) (match-end 0)))) (setq ret (setq string (replace-match newtext t literal string))) (setq start (- (length string) from-end)))) - ret) + ret) (if (not (string-match regexp string 0)) nil (replace-match newtext t literal string)))) @@ -2776,9 +2776,9 @@ If EOL, it should be an position to use instead of (or no-error (not (eq opoint (point))) (error "%s" (if hidden - (substitute-command-keys - "File line is hidden, type \\[dired-hide-subdir] to unhide") - "No file on this line"))) + (substitute-command-keys + "File line is hidden, type \\[dired-hide-subdir] to unhide") + "No file on this line"))) (if (eq opoint (point)) nil (point))))) @@ -2887,8 +2887,6 @@ dired-buffers." (substring pattern matched-in-pattern)) "\\'"))) - - (defun dired-advertise () ;;"Advertise in variable `dired-buffers' that we dired `default-directory'." ;; With wildcards we actually advertise too much. @@ -2936,8 +2934,8 @@ dired-buffers." (beginning-of-line) ; alist stores b-o-l positions (and (zerop (- (point) (cdr (assoc cur-dir - dired-subdir-alist)))) - cur-dir)))) + dired-subdir-alist)))) + cur-dir)))) (define-obsolete-function-alias 'dired-get-subdir-min 'cdr "27.1") @@ -3046,11 +3044,11 @@ instead of `dired-actual-switches'." new-dir-name) (setq new-dir-name res))) (dired-alist-add-1 new-dir-name - ;; Place a sub directory boundary between lines. - (save-excursion - (goto-char (match-beginning 0)) - (beginning-of-line) - (point-marker))))) + ;; Place a sub directory boundary between lines. + (save-excursion + (goto-char (match-beginning 0)) + (beginning-of-line) + (point-marker))))) (if (and (> count 1) (called-interactively-p 'interactive)) (message "Buffer includes %d directories" count))) ;; We don't need to sort it because it is in buffer order per @@ -3378,7 +3376,7 @@ non-empty directories is allowed." (defun dired-fun-in-all-buffers (directory file fun &rest args) "In all buffers dired'ing DIRECTORY, run FUN with ARGS. If the buffer has a wildcard pattern, check that it matches FILE. -(FILE does not include a directory component.) +\(FILE does not include a directory component.) FILE may be nil, in which case ignore it. Return list of buffers where FUN succeeded (i.e., returned non-nil)." (let (success-list) @@ -3860,8 +3858,7 @@ since it was last visited." (with-temp-buffer (insert-file-contents fn) (goto-char (point-min)) - (re-search-forward regexp nil t)))) - ))) + (re-search-forward regexp nil t))))))) "matching file"))) (defun dired-flag-files-regexp (regexp) @@ -4406,10 +4403,10 @@ Ask means pop up a menu for the user to select one of copy, move or link." (desktop-file-name dired-directory dirname)) ;; Subdirectories in `dired-subdir-alist'. (cdr - (nreverse - (mapcar - (lambda (f) (desktop-file-name (car f) dirname)) - dired-subdir-alist))))) + (nreverse + (mapcar + (lambda (f) (desktop-file-name (car f) dirname)) + dired-subdir-alist))))) (defun dired-restore-desktop-buffer (_file-name _buffer-name commit 4a3fc7179bd2bcb5d248f6fd1469227d00cfbdd4 Author: Jonas Bernoulli Date: Wed Jun 30 21:38:54 2021 +0200 ; Mention the previous change in NEWS diff --git a/etc/NEWS b/etc/NEWS index 55e8b6a7c2..7e95c20498 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2592,6 +2592,10 @@ GPG key servers can now be queried for keys with the 'M-x epa-search-keys' command. Keys can then be added to your personal key ring. ++++ +** Function 'lm-maintainer' was replaced with 'lm-maintainers'. +The former is now declared obsolete. + * New Modes and Packages in Emacs 28.1 commit 3cfc5532021357ef2e1284323e6936fafce484e5 Author: Jonas Bernoulli Date: Mon May 3 23:22:47 2021 +0200 Add new function lm-maintainers (bug#48592) * doc/lispref/tips.texi (Library Headers): Improve wording. * lisp/emacs-lisp/lisp-mnt.el (lm-maintainers): New function. (lm-maintainer): Make obsolete in favor of lm-maintainer. (lm-verify): Use lm-maintainers. (lm-report-bug): Use lm-maintainers. diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 36c68ee5ce..54cafffab3 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -1034,7 +1034,7 @@ the conventional possibilities for @var{header-name}: @table @samp @item Author -This line states the name and email address of at least the principal +This header states the name and email address of at least the principal author of the library. If there are multiple authors, list them on continuation lines led by @code{;;} and a tab or at least two spaces. We recommend including a contact email address, of the form @@ -1053,8 +1053,8 @@ This header has the same format as the Author header. It lists the person(s) who currently maintain(s) the file (respond to bug reports, etc.). -If there is no maintainer line, the person(s) in the Author field -is/are presumed to be the maintainers. Some files in Emacs use +If there is no Maintainer header, the person(s) in the Author header +is/are presumed to be the maintainer(s). Some files in Emacs use @samp{emacs-devel@@gnu.org} for the maintainer, which means the author is no longer responsible for the file, and that it is maintained as part of Emacs. diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 11a0440087..83da495edf 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -378,14 +378,22 @@ the cdr is an email address." (let ((authorlist (lm-header-multiline "author"))) (mapcar #'lm-crack-address authorlist)))) +(defun lm-maintainers (&optional file) + "Return the maintainer list of file FILE, or current buffer if FILE is nil. +If the maintainers are unspecified, then return the authors. +Each element of the list is a cons; the car is the full name, +the cdr is an email address." + (lm-with-file file + (mapcar #'lm-crack-address + (or (lm-header-multiline "maintainer") + (lm-header-multiline "author"))))) + (defun lm-maintainer (&optional file) "Return the maintainer of file FILE, or current buffer if FILE is nil. +If the maintainer is unspecified, then return the author. The return value has the form (NAME . ADDRESS)." - (lm-with-file file - (let ((maint (lm-header "maintainer"))) - (if maint - (lm-crack-address maint) - (car (lm-authors)))))) + (declare (obsolete lm-maintainers "28.1")) + (car (lm-maintainers file))) (defun lm-creation-date (&optional file) "Return the created date given in file FILE, or current buffer if FILE is nil." @@ -545,7 +553,7 @@ copyright notice is allowed." "Can't find package name") ((not (lm-authors)) "`Author:' tag missing") - ((not (lm-maintainer)) + ((not (lm-maintainers)) "`Maintainer:' tag missing") ((not (lm-summary)) "Can't find the one-line summary description") @@ -613,7 +621,7 @@ Prompts for bug subject TOPIC. Leaves you in a mail buffer." (interactive "sBug Subject: ") (require 'emacsbug) (let ((package (lm-get-package-name)) - (addr (lm-maintainer)) + (addr (car (lm-maintainers))) (version (lm-version))) (compose-mail (if addr (concat (car addr) " <" (cdr addr) ">") commit 0e3668b23323de130d6d8cda70c4669a4b7aa2f3 Author: Jonas Bernoulli Date: Sat May 22 21:58:53 2021 +0200 * lisp/emacs-lisp/lisp-mnt.el (lm-crack-address): Right-trim name. The addresses might be aligned in which case we have to trim the extra whitespace at the end of the names. diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 73a33a553f..11a0440087 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -360,10 +360,10 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")" "Split up an email address X into full name and real email address. The value is a cons of the form (FULLNAME . ADDRESS)." (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x) - (cons (match-string 1 x) + (cons (string-trim-right (match-string 1 x)) (match-string 2 x))) ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x) - (cons (match-string 2 x) + (cons (string-trim-right (match-string 2 x)) (match-string 1 x))) ((string-match "\\S-+@\\S-+" x) (cons nil x)) commit 1439e9bfadb2ba66f55530daab1f9886c7a98c02 Author: João Távora Date: Wed Jun 30 17:00:13 2021 +0100 Adjust docstring of lisp-mode (bug#49278) * lisp/emacs-lisp/lisp-mode.el (lisp-mode): Mention that this mode is primarily for Common Lisp. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 59325d647d..51fb88502a 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -765,7 +765,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"])) (define-derived-mode lisp-mode lisp-data-mode "Lisp" - "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp. + "Major mode for editing programs in Common Lisp and other similar Lisps. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. commit bb56f6c768acc070a8058bc8e7c91d5ee069ef7f Author: Lars Ingebrigtsen Date: Wed Jun 30 15:55:50 2021 +0200 Add new user option to transform kill ring contents * doc/emacs/killing.texi (Kill Options): Document it. * lisp/simple.el (kill-new): Use it. (kill-transform-function): New user option (bug#29013). diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 4291afec56..6e4fd77e8b 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -269,6 +269,21 @@ happens. But if you set the variable @code{kill-read-only-ok} to a non-@code{nil} value, they just print a message in the echo area to explain why the text has not been erased. +@vindex kill-transform-function + Before saving the kill to the kill ring, you can transform the +string using @code{kill-transform-function}. It's called with the +string to be killed, and it should return the string you want to be +saved. It can also return @code{nil}, in which case the string won't +be saved to the kill ring. For instance, if you never want to save +a pure white space string to the kill ring, you can say: + +@lisp +(setq kill-transform-function + (lambda (string) + (and (not (string-blank-p string)) + string))) +@end lisp + @vindex kill-do-not-save-duplicates If you change the variable @code{kill-do-not-save-duplicates} to a non-@code{nil} value, identical subsequent kills yield a single diff --git a/etc/NEWS b/etc/NEWS index 701b9a73a8..55e8b6a7c2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2142,6 +2142,11 @@ summaries will include the failing condition. ** Miscellaneous ++++ +*** New user option 'kill-transform-function'. +This can be used to transform (and suppress) strings from entering the +kill ring. + --- *** `C-u M-x dig' will now prompt for a query type to use. diff --git a/lisp/simple.el b/lisp/simple.el index 71db7ffe5d..f746d738a6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5060,6 +5060,16 @@ The comparison is done using `equal-including-properties'." :group 'killing :version "23.2") +(defcustom kill-transform-function nil + "Function to call to transform a string before it's put on the kill ring. +The function is called with one parameter (the string that's to +be put on the kill ring). It should return a string or nil. If +the latter, the string is not put on the kill ring." + :type '(choice (const :tag "No transform" nil) + function) + :group 'killing + :version "28.1") + (defun kill-new (string &optional replace) "Make STRING the latest kill in the kill ring. Set `kill-ring-yank-pointer' to point to it. @@ -5075,38 +5085,41 @@ When the yank handler has a non-nil PARAM element, the original STRING argument is not used by `insert-for-yank'. However, since Lisp code may access and use elements from the kill ring directly, the STRING argument should still be a \"useful\" string for such uses." - (unless (and kill-do-not-save-duplicates - ;; Due to text properties such as 'yank-handler that - ;; can alter the contents to yank, comparison using - ;; `equal' is unsafe. - (equal-including-properties string (car kill-ring))) - (if (fboundp 'menu-bar-update-yank-menu) - (menu-bar-update-yank-menu string (and replace (car kill-ring))))) - (when save-interprogram-paste-before-kill - (let ((interprogram-paste (and interprogram-paste-function - (funcall interprogram-paste-function)))) - (when interprogram-paste - (setq interprogram-paste - (if (listp interprogram-paste) - ;; Use `reverse' to avoid modifying external data. - (reverse interprogram-paste) - (list interprogram-paste))) - (when (or (not (numberp save-interprogram-paste-before-kill)) - (< (seq-reduce #'+ (mapcar #'length interprogram-paste) 0) - save-interprogram-paste-before-kill)) - (dolist (s interprogram-paste) - (unless (and kill-do-not-save-duplicates - (equal-including-properties s (car kill-ring))) - (push s kill-ring))))))) - (unless (and kill-do-not-save-duplicates - (equal-including-properties string (car kill-ring))) - (if (and replace kill-ring) - (setcar kill-ring string) - (let ((history-delete-duplicates nil)) - (add-to-history 'kill-ring string kill-ring-max t)))) - (setq kill-ring-yank-pointer kill-ring) - (if interprogram-cut-function - (funcall interprogram-cut-function string))) + ;; Allow the user to transform or ignore the string. + (when (or (not kill-transform-function) + (setq string (funcall kill-transform-function string))) + (unless (and kill-do-not-save-duplicates + ;; Due to text properties such as 'yank-handler that + ;; can alter the contents to yank, comparison using + ;; `equal' is unsafe. + (equal-including-properties string (car kill-ring))) + (if (fboundp 'menu-bar-update-yank-menu) + (menu-bar-update-yank-menu string (and replace (car kill-ring))))) + (when save-interprogram-paste-before-kill + (let ((interprogram-paste (and interprogram-paste-function + (funcall interprogram-paste-function)))) + (when interprogram-paste + (setq interprogram-paste + (if (listp interprogram-paste) + ;; Use `reverse' to avoid modifying external data. + (reverse interprogram-paste) + (list interprogram-paste))) + (when (or (not (numberp save-interprogram-paste-before-kill)) + (< (seq-reduce #'+ (mapcar #'length interprogram-paste) 0) + save-interprogram-paste-before-kill)) + (dolist (s interprogram-paste) + (unless (and kill-do-not-save-duplicates + (equal-including-properties s (car kill-ring))) + (push s kill-ring))))))) + (unless (and kill-do-not-save-duplicates + (equal-including-properties string (car kill-ring))) + (if (and replace kill-ring) + (setcar kill-ring string) + (let ((history-delete-duplicates nil)) + (add-to-history 'kill-ring string kill-ring-max t)))) + (setq kill-ring-yank-pointer kill-ring) + (if interprogram-cut-function + (funcall interprogram-cut-function string)))) ;; It has been argued that this should work like `self-insert-command' ;; which merges insertions in `buffer-undo-list' in groups of 20 commit 46a66c6248be20c7c3ef7f57a8f25af39b975eb6 Author: Lars Ingebrigtsen Date: Wed Jun 30 15:31:26 2021 +0200 Make the minor mode doc strings say that they're minor modes * lisp/emacs-lisp/easy-mmode.el (easy-mmode--arg-docstring): Mention that this is a minor mode (bug#20462). diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index cc15011712..3a00fdb454 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -84,9 +84,9 @@ replacing its case-insensitive matches with the literal string in LIGHTER." (defconst easy-mmode--arg-docstring " -If called interactively, toggle `%s'. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `%s' +mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. commit cbf220bc31c0a00c45b22c140eda7854d81d991b Author: Peter Oliver Date: Wed Jun 30 15:11:21 2021 +0200 From .desktop files, reuse a frame or start a new Emacs as required * doc/emacs/misc.texi: (Using Emacs as a Server) Explain emacsclient.desktop. * etc/NEWS: (Emacs Server): Explain emacsclient.desktop. * emacs-mail.desktop, etc/emacsclient.desktop: Automatically try to reuse an existing frame, open a new frame, or start a new Emacs daemon. Add actions for specific behaviours (bug#49195). diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 027133cc3a..3c11a39de9 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1757,6 +1757,13 @@ expression @code{(+ 1 2)} on the @samp{foo} server, and returns @code{3}. (If there is no server with that name, an error is signaled.) Currently, this feature is mainly useful for developers. + If your operating system’s desktop environment is +@url{https://www.freedesktop.org/wiki/Specifications/,,freedesktop.org-compatible} +(which is true of most GNU/Linux and other recent Unix-like GUIs), you +may use the @samp{Emacs (Client)} menu entry to connect to an Emacs +server with @command{emacsclient}. The daemon starts if not +already running. + @menu * TCP Emacs server:: Listening to a TCP socket. * Invoking emacsclient:: Connecting to the Emacs server. diff --git a/etc/NEWS b/etc/NEWS index 6345992dfe..701b9a73a8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -537,6 +537,14 @@ an edit instead of marking it as "Done" (which the 'C-x #' command does). The 'emacsclient' program exits with an abnormal status as result of this command. ++++ +*** New desktop integration for connecting to the server. +If your operating system’s desktop environment is +freedesktop.org-compatible (which is true of most GNU/Linux and other +recent Unix-like GUIs), you may use the new "Emacs (Client)" desktop +menu entry to open files in an existing Emacs instance rather than +starting a new one. The daemon starts if not already running. + ** Perl mode --- diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop index 0c5fab1dd1..251afa100c 100644 --- a/etc/emacs-mail.desktop +++ b/etc/emacs-mail.desktop @@ -1,12 +1,22 @@ [Desktop Entry] Categories=Network;Email; Comment=GNU Emacs is an extensible, customizable text editor - and more -Exec=emacs -f message-mailto %u -# If you prefer to use emacsclient, use this instead -#Exec=emacsclient -e '(message-mailto "%u")' Icon=emacs Name=Emacs (Mail) MimeType=x-scheme-handler/mailto; NoDisplay=false Terminal=false Type=Application + +Exec=emacs -f message-mailto %u +# # If you prefer to use emacsclient, use this instead: +# Exec=sh -c 'emacsclient --alternate-editor= --display="$DISPLAY" --eval "(message-mailto \"%u\")"' +# Actions=new-window;new-instance; + +# [Desktop Action new-window] +# Name=New Window +# Exec=emacsclient --alternate-editor= --create-frame --eval '(message-mailto "%u")' + +# [Desktop Action new-instance] +# Name=New Instance +# Exec=emacs -f message-mailto %u diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop index f76fb2f5d9..361051e611 100644 --- a/etc/emacsclient.desktop +++ b/etc/emacsclient.desktop @@ -3,7 +3,7 @@ Name=Emacs (Client) GenericName=Text Editor Comment=Edit text MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++; -Exec=emacsclient -c %F +Exec=sh -c 'if [ -n "$*" ]; then exec emacsclient --alternate-editor= --display="$DISPLAY" "$@"; else exec emacsclient --alternate-editor= --create-frame; fi' placeholder %F Icon=emacs Type=Application Terminal=false @@ -11,3 +11,12 @@ Categories=Development;TextEditor; StartupNotify=true StartupWMClass=Emacs Keywords=Text;Editor; +Actions=new-window;new-instance; + +[Desktop Action new-instance] +Name=New Window +Exec=emacsclient --alternate-editor= --create-frame %F + +[Desktop Action new-instance] +Name=New Instance +Exec=emacs %F commit f355f32e69b1389f7d51b8a50c0a9c064dc2cb32 Author: Peter Oliver Date: Wed Jun 30 15:01:46 2021 +0200 Revert more of a partially reverted emacsclient.desktop patch * etc/emacsclient.desktop: Undo setting of StartupWMClass=Emacsd, since this relies on a change to etc/emacs.service which was also undone. See bug#37847 for more explanation (bug#49259). diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop index 2c1edb4b66..f76fb2f5d9 100644 --- a/etc/emacsclient.desktop +++ b/etc/emacsclient.desktop @@ -9,5 +9,5 @@ Type=Application Terminal=false Categories=Development;TextEditor; StartupNotify=true -StartupWMClass=Emacsd +StartupWMClass=Emacs Keywords=Text;Editor; commit 81622484bc711f98bf7b4b5f84052590a0ae5d3f Author: Lars Ingebrigtsen Date: Wed Jun 30 14:27:49 2021 +0200 Fix problem when creating an .authinfo entry with an existing machine name * lisp/auth-source.el (auth-source-netrc-create): Don't return the incorrect data if there's a matching host entry but the wrong user name (bug#49289). diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 9ca28ebb0a..6919738398 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1270,7 +1270,7 @@ See `auth-source-search' for details on SPEC." ;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) (cl-defun auth-source-netrc-create (&rest spec - &key backend host port create + &key backend host port create user &allow-other-keys) (let* ((base-required '(host user port secret)) ;; we know (because of an assertion in auth-source-search) that the @@ -1278,6 +1278,7 @@ See `auth-source-search' for details on SPEC." (create-extra (if (eq t create) nil create)) (current-data (car (auth-source-search :max 1 :host host + :user user :port port))) (required (append base-required create-extra)) (file (oref backend source)) commit 4f2765f6f1a2cc6da408e3c5ff99ea5f8756bad4 Author: Colin Woodbury Date: Wed Jun 30 14:07:29 2021 +0200 Add new function file-name-with-extension * doc/lispref/files.texi (File Name Components): Document it. * lisp/emacs-lisp/shortdoc.el (file-name): Ditto. * lisp/files.el (file-name-with-extension): New function. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 2033177fbb..dd9ce2cd01 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2129,6 +2129,25 @@ the period that delimits the extension, and if @var{filename} has no extension, the value is @code{""}. @end defun +@defun file-name-with-extension filename extension +This function returns @var{filename} with its extension set to +@var{extension}. A single leading dot in the @var{extension} will be +stripped if there is one. For example: + +@example +(file-name-with-extension "file" "el") + @result{} "file.el" +(file-name-with-extension "file" ".el") + @result{} "file.el" +(file-name-with-extension "file.c" "el") + @result{} "file.el" +@end example + +Note that this function will error if @var{filename} or +@var{extension} are empty, or if the @var{filename} is shaped like a +directory (i.e. if @code{directory-name-p} returns non-@code{nil}). +@end defun + @defun file-name-sans-extension filename This function returns @var{filename} minus its extension, if any. The version/backup part, if present, is only removed if the file has an diff --git a/etc/NEWS b/etc/NEWS index b9a9369049..6345992dfe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3058,6 +3058,11 @@ been added, and takes a callback to handle the return status. --- ** 'ascii' is now a coding system alias for 'us-ascii'. ++++ +** New function 'file-name-with-extension'. +This function allows a canonical way to set/replace the extension of a +filename string. + +++ ** New function 'file-backup-file-names'. This function returns the list of file names of all the backup files diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 4ff7cee623..4df404015a 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -268,6 +268,9 @@ There can be any number of :example/:result elements." :eval (file-name-extension "/tmp/foo.txt")) (file-name-sans-extension :eval (file-name-sans-extension "/tmp/foo.txt")) + (file-name-with-extension + :eval (file-name-with-extension "foo.txt" "bin") + :eval (file-name-with-extension "foo" "bin")) (file-name-base :eval (file-name-base "/tmp/foo.txt")) (file-relative-name diff --git a/lisp/files.el b/lisp/files.el index 04db0faffd..39f4ca65b1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4894,6 +4894,27 @@ extension, the value is \"\"." (if period ""))))) +(defun file-name-with-extension (filename extension) + "Set the EXTENSION of a FILENAME. +The extension (in a file name) is the part that begins with the last \".\". + +Trims a leading dot from the EXTENSION so that either \"foo\" or +\".foo\" can be given. + +Errors if the filename or extension are empty, or if the given +filename has the format of a directory. + +See also `file-name-sans-extension'." + (let ((extn (string-trim-left extension "[.]"))) + (cond ((string-empty-p filename) + (error "Empty filename: %s" filename)) + ((string-empty-p extn) + (error "Malformed extension: %s" extension)) + ((directory-name-p filename) + (error "Filename is a directory: %s" filename)) + (t + (concat (file-name-sans-extension filename) "." extn))))) + (defun file-name-base (&optional filename) "Return the base name of the FILENAME: no directory, no extension." (declare (advertised-calling-convention (filename) "27.1")) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index dc96dff639..257cbc2d32 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1478,5 +1478,23 @@ The door of all subtleties! (buffer-substring (point-min) (point-max)) nil nil))))) +(ert-deftest files-tests-file-name-with-extension-good () + "Test that `file-name-with-extension' succeeds with reasonable input." + (should (string= (file-name-with-extension "Jack" "css") "Jack.css")) + (should (string= (file-name-with-extension "Jack" ".css") "Jack.css")) + (should (string= (file-name-with-extension "Jack.scss" "css") "Jack.css")) + (should (string= (file-name-with-extension "/path/to/Jack.md" "org") "/path/to/Jack.org"))) + +(ert-deftest files-tests-file-name-with-extension-bad () + "Test that `file-name-with-extension' fails on malformed input." + (should-error (file-name-with-extension nil nil)) + (should-error (file-name-with-extension "Jack" nil)) + (should-error (file-name-with-extension nil "css")) + (should-error (file-name-with-extension "" "")) + (should-error (file-name-with-extension "" "css")) + (should-error (file-name-with-extension "Jack" "")) + (should-error (file-name-with-extension "Jack" ".")) + (should-error (file-name-with-extension "/is/a/directory/" "css"))) + (provide 'files-tests) ;;; files-tests.el ends here commit 1dba0ca278f8185912e8d39b2af05fc6739b65f8 Author: Alan Third Date: Tue Jun 29 22:17:20 2021 +0100 Fix NS port built with gcc * src/nsterm.m (ns_relocate): The NSArray shorthand notation doesn't work in GCC. diff --git a/src/nsterm.m b/src/nsterm.m index 8497138039..dc5ecc4564 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -511,7 +511,9 @@ - (NSColor *)colorUsingDefaultColorSpace NSBundle *bundle = [NSBundle mainBundle]; NSString *root = [bundle bundlePath]; NSString *original = [NSString stringWithUTF8String:epath]; - NSString *fixedPath = [NSString pathWithComponents:@[root, original]]; + NSString *fixedPath = [NSString pathWithComponents: + [NSArray arrayWithObjects: + root, original, nil]]; NSFileManager *fileManager = [NSFileManager defaultManager]; if (![original isAbsolutePath] commit 94a2ef436b857d8b9909d8629190bd3fbb1be5d7 Author: Juri Linkov Date: Tue Jun 29 23:36:16 2021 +0300 * lisp/repeat.el (describe-repeat): New command (bug#49265). diff --git a/lisp/repeat.el b/lisp/repeat.el index 46c880d0dd..503cb34000 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -397,7 +397,7 @@ When Repeat mode is enabled, and the command symbol has the property named (and (commandp s) (get s 'repeat-map) (push (get s 'repeat-map) keymaps)))))) - (message "Repeat mode is enabled for %d commands and %d keymaps" + (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat'." (length commands) (length (delete-dups keymaps)))))) @@ -489,6 +489,28 @@ When Repeat mode is enabled, and the command symbol has the property named repeat-echo-mode-line-string))) (force-mode-line-update t))) +(defun describe-repeat () + "Describe repeatable commands and keymaps." + (interactive) + (help-setup-xref (list #'describe-repeat) + (called-interactively-p 'interactive)) + (let ((keymaps nil)) + (all-completions + "" obarray (lambda (s) + (and (commandp s) + (get s 'repeat-map) + (push s (alist-get (get s 'repeat-map) keymaps))))) + (with-help-window (help-buffer) + (with-current-buffer standard-output + (princ "This is a list of repeatable keymaps and commands.\n\n") + + (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b))))) + (princ (format-message "`%s' keymap is repeatable by these commands:\n" + (car keymap))) + (dolist (command (sort (cdr keymap) 'string-lessp)) + (princ (format-message " `%s'\n" command))) + (princ "\n")))))) + (provide 'repeat) ;;; repeat.el ends here commit cd339e85a695f40d93b5ce9f4e65075dd979b25b Author: Michael Albinus Date: Tue Jun 29 17:15:55 2021 +0200 Sync with Tramp 2.5.1 * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.5.1". * lisp/tramp.el (tramp-handle-write-region): * lisp/tramp-adb.el (tramp-adb-handle-write-region): * lisp/tramp-sh.el (tramp-sh-handle-write-region): Call local `write-region' directly. * test/lisp/net/tramp-tests.el (tramp--test-utf8): Adapt test for MS Windows. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 827c477328..10c951d3cc 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version numbers are auto-frobbed from @c tramp.el, and the bug report address is auto-frobbed from @c configure.ac. -@set trampver 2.5.1-pre +@set trampver 2.5.1 @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 25.1 diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index aacf83e663..7fb0ff5780 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -549,8 +549,7 @@ But handle the case, if the \"test\" command is not available." (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok) (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600))) - (tramp-run-real-handler - #'write-region (list start end tmpfile append 'no-message lockname)) + (write-region start end tmpfile append 'no-message lockname) (with-tramp-progress-reporter v 3 (format-message "Moving tmp file `%s' to `%s'" tmpfile filename) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b613ad3f8e..ebd0fbfd2d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3225,7 +3225,6 @@ implementation will be used." (run-hooks 'tramp-handle-file-local-copy-hook) tmpfile))) -;; CCC grok LOCKNAME (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." @@ -3254,9 +3253,7 @@ implementation will be used." (or (file-directory-p localname) (file-writable-p localname))))) ;; Short track: if we are on the local host, we can run directly. - (tramp-run-real-handler - #'write-region - (list start end localname append 'no-message lockname)) + (write-region start end localname append 'no-message lockname) (let* ((modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) @@ -3289,13 +3286,10 @@ implementation will be used." ;; file. We call `set-visited-file-modtime' ourselves later ;; on. We must ensure that `file-coding-system-alist' ;; matches `tmpfile'. - (let (file-name-handler-alist - (file-coding-system-alist + (let ((file-coding-system-alist (tramp-find-file-name-coding-system-alist filename tmpfile))) (condition-case err - (tramp-run-real-handler - #'write-region - (list start end tmpfile append 'no-message lockname)) + (write-region start end tmpfile append 'no-message lockname) ((error quit) (setq tramp-temp-buffer-file-name nil) (delete-file tmpfile) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c3b088aebb..ee7e0cf2c3 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4393,8 +4393,7 @@ of." ;; We say `no-message' here because we don't want the visited file ;; modtime data to be clobbered from the temp file. We call ;; `set-visited-file-modtime' ourselves later on. - (tramp-run-real-handler - #'write-region (list start end tmpfile append 'no-message lockname)) + (write-region start end tmpfile append 'no-message lockname) (condition-case nil (rename-file tmpfile filename 'ok-if-already-exists) (error diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index abd92219b2..e6cf4c6ac5 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.5.1-pre +;; Version: 2.5.1 ;; Package-Requires: ((emacs "25.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.5.1-pre" +(defconst tramp-version "2.5.1" "This version of Tramp.") ;;;###tramp-autoload @@ -76,7 +76,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-lessp emacs-version "25.1")) "ok" - (format "Tramp 2.5.1-pre is not fit for %s" + (format "Tramp 2.5.1 is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 37cd701161..6aa8629f33 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -6280,8 +6280,9 @@ Use the `ls' command." x "")) (not (string-empty-p x)) ;; ?\n and ?/ shouldn't be part of any file name. ?\t, - ;; ?. and ?? do not work for "smb" method. - (replace-regexp-in-string "[\t\n/.?]" "" x))) + ;; ?. and ?? do not work for "smb" method. " " does not + ;; work at begin or end of the string for MS Windows. + (replace-regexp-in-string "[ \t\n/.?]" "" x))) language-info-alist))))))) (ert-deftest tramp-test41-utf8 () commit e3f456255bb26ca7e3c8350a62aa724a56e60059 Author: Alex McGrath Date: Tue Jun 29 13:04:33 2021 +0100 Fix SASL joining channels after auth diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index d1b87abb62..154413871c 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -3516,7 +3516,8 @@ PROCESS is the process object for the current connection." (rcirc-handler-generic process "900" sender args nil) (when (not rcirc-finished-sasl) (setq-local rcirc-finished-sasl t) - (rcirc-send-string process "CAP" "END"))) + (rcirc-send-string process "CAP" "END")) + (rcirc-join-channels-post-auth process)) (defgroup rcirc-faces nil commit a85d27278eaf0214cdb2f6c4f3b764f2392f068b Author: Alex McGrath Date: Tue Jun 29 12:06:22 2021 +0100 Send CAP END after authentication has been successful diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 0feafd708a..d1b87abb62 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -657,8 +657,6 @@ that are joined after authentication." (or server-alias server) nil server port-number :type (or encryption 'plain)))) ;; set up process - (when use-sasl - (setq-local rcirc-finished-sasl nil)) (set-process-coding-system process 'raw-text 'raw-text) (switch-to-buffer (rcirc-generate-new-buffer-name process nil)) (set-process-buffer process (current-buffer)) @@ -682,6 +680,8 @@ that are joined after authentication." (add-hook 'auto-save-hook 'rcirc-log-write) + (when use-sasl + (setq-local rcirc-finished-sasl nil)) ;; identify (dolist (cap rcirc-implemented-capabilities) (rcirc-send-string process "CAP" "REQ" : cap) @@ -3509,9 +3509,14 @@ PROCESS is the process object for the current connection." (base64-encode-string ;; use connection user-name (concat "\0" (nth 3 rcirc-connection-info) - "\0" (rcirc-get-server-password rcirc-server)))) - (setq-local rcirc-finished-sasl t) - (rcirc-send-string process "CAP" "END")) + "\0" (rcirc-get-server-password rcirc-server))))) + +(defun rcirc-handler-900 (process sender args _text) + "Respond to a successful authentication response" + (rcirc-handler-generic process "900" sender args nil) + (when (not rcirc-finished-sasl) + (setq-local rcirc-finished-sasl t) + (rcirc-send-string process "CAP" "END"))) (defgroup rcirc-faces nil commit 6b4043833cf2e846d41e714e2c72372b60d0d594 Author: Martin Rudalics Date: Tue Jun 29 09:21:22 2021 +0200 In read_minibuf_unwind don't try to select dead window (Bug#49248) * src/minibuf.c (read_minibuf_unwind): Don't try to select dead window (Bug#49248). diff --git a/src/minibuf.c b/src/minibuf.c index 00069eabbe..1b842b7721 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1210,7 +1210,7 @@ read_minibuf_unwind (void) WINDOW_FRAME (XWINDOW (minibuf_window)))) Fset_frame_selected_window (selected_frame, prev, Qnil); } - else + else if (WINDOW_LIVE_P (calling_window)) Fset_frame_selected_window (calling_frame, calling_window, Qnil); } commit df6efb1c8b0b1c64d183f966da00401593b5e96b Author: Alex McGrath Date: Mon Jun 28 13:41:31 2021 +0100 Fix SASL on rcirc-update diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 37c31be58f..0feafd708a 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -610,6 +610,8 @@ See `rcirc-connect' for more details on these variables.") "A list of capabilities that client has requested.") (defvar-local rcirc-acked-capabilities nil "A list of capabilities that the server supports.") +(defvar-local rcirc-finished-sasl t + "Check whether SASL authentication has completed") (defun rcirc-get-server-method (server) "Return authentication method for SERVER." @@ -650,10 +652,13 @@ that are joined after authentication." (user-name (or user-name rcirc-default-user-name)) (full-name (or full-name rcirc-default-full-name)) (startup-channels startup-channels) + (use-sasl (eq (rcirc-get-server-method server) 'sasl)) (process (open-network-stream (or server-alias server) nil server port-number :type (or encryption 'plain)))) ;; set up process + (when use-sasl + (setq-local rcirc-finished-sasl nil)) (set-process-coding-system process 'raw-text 'raw-text) (switch-to-buffer (rcirc-generate-new-buffer-name process nil)) (set-process-buffer process (current-buffer)) @@ -685,6 +690,10 @@ that are joined after authentication." (rcirc-send-string process "PASS" password)) (rcirc-send-string process "NICK" nick) (rcirc-send-string process "USER" user-name "0" "*" : full-name) + ;; Setup sasl, and initiate authentication. + (when (and rcirc-auto-authenticate-flag + use-sasl) + (rcirc-send-string process "AUTHENTICATE" "PLAIN")) ;; setup ping timer if necessary (unless rcirc-keepalive-timer @@ -3435,7 +3444,7 @@ is the process object for the current connection." ((string= subcmd "NAK") (setq rcirc-requested-capabilities (delete cap rcirc-requested-capabilities)))))) - (when (null rcirc-requested-capabilities) + (when (and (null rcirc-requested-capabilities) rcirc-finished-sasl) ;; All requested capabilities have been responded to (rcirc-send-string process "CAP" "END")))) @@ -3500,7 +3509,9 @@ PROCESS is the process object for the current connection." (base64-encode-string ;; use connection user-name (concat "\0" (nth 3 rcirc-connection-info) - "\0" (rcirc-get-server-password rcirc-server))))) + "\0" (rcirc-get-server-password rcirc-server)))) + (setq-local rcirc-finished-sasl t) + (rcirc-send-string process "CAP" "END")) (defgroup rcirc-faces nil commit 433e157899063741c4e047616e3b52ecc8ae6476 Merge: 7c93009d11 ef5f3d5ee7 Author: Glenn Morris Date: Mon Jun 28 07:50:45 2021 -0700 Merge from origin/emacs-27 ef5f3d5ee7 (origin/emacs-27) C++ Mode: Handle new keywords static_cas... commit 7c93009d11fd791f698e5cb7d0d281a82ccbb890 Author: Reuben Thomas Date: Sun Jun 27 22:08:40 2021 +0100 * lisp/textmodes/ispell.el: Fix finding dictionaries for Enchant. (ispell-find-enchant-dictionaries): I originally copied this code from the equivalent code for Aspell. Unfortunately it was wrong for the case of Enchant: it should find only dictionaries that Enchant knows about, and not merge in `ispell-dictionary-base-alist' or add a default element, as these are dealt with in `ispell-set-spellchecker-params'. This caused a bug where the correct `-d' argument would not be added to the invocation of enchant, leading to the process not being correctly started. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 84d7208151..ce5a572085 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1211,18 +1211,7 @@ If LANG is omitted, get the extra word characters for the default language." `(,lang "[[:alpha:]]" "[^[:alpha:]]" ,(ispell--get-extra-word-characters lang) t nil nil utf-8)) dictionaries))) - ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist - ;; which have no element in FOUND at all. - (dolist (dict ispell-dictionary-base-alist) - (unless (assoc (car dict) found) - (setq found (nconc found (list dict))))) - (setq ispell-enchant-dictionary-alist found) - ;; Add a default entry - (let ((default-dict - `(nil "[[:alpha:]]" "[^[:alpha:]]" - ,(ispell--get-extra-word-characters) - t nil nil utf-8))) - (push default-dict ispell-enchant-dictionary-alist)))) + (setq ispell-enchant-dictionary-alist found))) ;; Set params according to the selected spellchecker commit 881e75873dfb15077413d96c6606bbf042ab0a93 Author: Reuben Thomas Date: Sun Jun 27 22:07:06 2021 +0100 * lisp/textmodes/ispell.el: Check process is live before interacting. Check that `ispell-process' is live before trying to read from or write to it. This avoids a hang if the process has died. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 4dbc7640bc..84d7208151 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1765,10 +1765,12 @@ You can set this variable in hooks in your init file -- eg: If asynchronous subprocesses are not supported, call function `ispell-filter' and pass it the output of the last Ispell invocation." (if ispell-async-processp - (let ((timeout (if timeout-msecs - (+ (or timeout-secs 0) (/ timeout-msecs 1000.0)) - timeout-secs))) - (accept-process-output ispell-process timeout)) + (if (process-live-p ispell-process) + (let ((timeout (if timeout-msecs + (+ (or timeout-secs 0) (/ timeout-msecs 1000.0)) + timeout-secs))) + (accept-process-output ispell-process timeout)) + (error "No Ispell process to read output from!")) (if (null ispell-process) (error "No Ispell process to read output from!") (let ((buf ispell-output-buffer) @@ -1793,7 +1795,8 @@ Only works for Aspell and Enchant." (defun ispell-send-string (string) "Send the string STRING to the Ispell process." (if ispell-async-processp - (process-send-string ispell-process string) + (if (process-live-p ispell-process) + (process-send-string ispell-process string)) ;; Asynchronous subprocesses aren't supported on this losing system. ;; We keep all the directives passed to Ispell during the entire ;; session in a buffer, and pass them anew each time we invoke commit e9de80f028cdd1c551061db68ee2f9b40b555085 Author: Mattias Engdegård Date: Mon Jun 28 11:44:07 2021 +0200 ; * Makefile.in: Fix out-of-tree builds on NS diff --git a/Makefile.in b/Makefile.in index 420cb544a4..8fccdf7580 100644 --- a/Makefile.in +++ b/Makefile.in @@ -414,7 +414,7 @@ epaths-force-w32: # between macOS and GNUstep, so just replace any references to the app # bundle root itself with the relative path. epaths-force-ns-self-contained: epaths-force - @(sed < ${srcdir}/src/epaths.h > epaths.h.$$$$ \ + @(sed < src/epaths.h > epaths.h.$$$$ \ -e 's;${ns_appdir}/;;') && \ ${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h commit de265a0c6ef8b1296d5a6130cb87b6dc74286b67 Author: Michael Albinus Date: Mon Jun 28 08:14:10 2021 +0200 Fix bug#49229 in shell.el * lisp/shell.el (shell): Ensure, that a remote shell is remote. (Bug#49229) diff --git a/lisp/shell.el b/lisp/shell.el index 62de5be817..4339e8c0a3 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -759,7 +759,8 @@ Make the shell buffer the current buffer, and return it. (file-local-name (expand-file-name (read-file-name "Remote shell path: " default-directory - shell-file-name t shell-file-name))))) + shell-file-name t shell-file-name + #'file-remote-p))))) ;; Rain or shine, BUFFER must be current by now. (unless (comint-check-proc buffer) commit 9060fbd3b5cd3ccae5ef88a0204332b75af94532 Author: Stefan Monnier Date: Sun Jun 27 18:01:13 2021 -0400 * lisp/files.el (hack-one-local-variable): Allow `add-function` in `eval:` Fixes: bug#49163 diff --git a/lisp/files.el b/lisp/files.el index 5d2fe0a77b..04db0faffd 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4041,7 +4041,7 @@ already the major mode." ('eval (pcase val (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook))) - (save-excursion (eval val))) + (save-excursion (eval val t))) (_ (hack-one-local-variable--obsolete var) ;; Make sure the string has no text properties. commit fe81c044892693ebd2dbeebffdcdf7e0c4bb7875 Author: Stefan Monnier Date: Sun Jun 27 15:06:25 2021 -0400 * lisp/textmodes/flyspell.el: Fix bug#49104 (flyspell--prev-meta-tab-binding): Delete var. (flyspell-prog-mode): Don't set it. (flyspell-auto-correct-word): Lookup the "next" command dynamically. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index ba48e5de21..836d889a1c 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -401,18 +401,12 @@ like \"Some." (let ((f (get-text-property (1- (point)) 'face))) (memq f flyspell-prog-text-faces)))) -(defvar flyspell--prev-meta-tab-binding nil - "Records the binding of M-TAB in effect before flyspell was activated.") - ;;;###autoload (defun flyspell-prog-mode () "Turn on `flyspell-mode' for comments and strings." (interactive) (setq flyspell-generic-check-word-predicate #'flyspell-generic-progmode-verify) - (setq-local flyspell--prev-meta-tab-binding - (or (local-key-binding "\M-\t" t) - (global-key-binding "\M-\t" t))) (flyspell-mode 1) (run-hooks 'flyspell-prog-mode-hook)) @@ -1990,15 +1984,14 @@ spell-check." (interactive) ;; If we are not in the construct where flyspell should be active, ;; invoke the original binding of M-TAB, if that was recorded. - (if (and (local-variable-p 'flyspell--prev-meta-tab-binding) - (commandp flyspell--prev-meta-tab-binding t) - (functionp flyspell-generic-check-word-predicate) - (not (funcall flyspell-generic-check-word-predicate)) - (equal (where-is-internal 'flyspell-auto-correct-word nil t) - [?\M-\t])) - (call-interactively flyspell--prev-meta-tab-binding) - (let ((pos (point)) - (old-max (point-max))) + (let ((pos (point)) + (old-max (point-max)) + (next-cmd (and (functionp flyspell-generic-check-word-predicate) + (not (funcall flyspell-generic-check-word-predicate)) + (let ((flyspell-mode nil)) + (key-binding (this-command-keys)))))) + (if next-cmd + (command-execute next-cmd) ;; Flush a possibly stale cache from previous invocations of ;; flyspell-auto-correct-word/flyspell-auto-correct-previous-word. (if (not (memq last-command '(flyspell-auto-correct-word commit ef5f3d5ee7211430e5af4952042a0bebdcbc27ff Author: Alan Mackenzie Date: Sun Jun 27 12:59:18 2021 +0000 C++ Mode: Handle new keywords static_cast, etc., wrt angle brackets * lisp/progmodes/cc-langs.el (c-<>-arglist-kwds): Add const_cast, dynamic_cast, reinterpret_cast and static_cast into this lang const. * lisp/progmodes/cc-engine.el (c-clear-<-pair-props, c-clear->-pair-props) (c-clear-<-pair-props-if-match-after, c-clear->-pair-props-if-match-before) (c-forward-<>-arglist-recur): Invalidate caches with c-trunctate-lit-pos-cache. (c-forward-<>-arglist-recur): If in a matching <...> expression, the < has a syntax-table property, but the > not, remove that property. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 5a0f935075..9cba87f4d9 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6868,8 +6868,10 @@ comment at the start of cc-engine.el for more info." (c-go-list-forward)) (when (equal (c-get-char-property (1- (point)) 'syntax-table) c->-as-paren-syntax) ; should always be true. - (c-unmark-<->-as-paren (1- (point)))) - (c-unmark-<->-as-paren pos)))) + (c-unmark-<->-as-paren (1- (point))) + (c-truncate-lit-pos-cache (1- (point)))) + (c-unmark-<->-as-paren pos) + (c-truncate-lit-pos-cache pos)))) (defun c-clear->-pair-props (&optional pos) ;; POS (default point) is at a > character. If it is marked with @@ -6885,8 +6887,10 @@ comment at the start of cc-engine.el for more info." (c-go-up-list-backward)) (when (equal (c-get-char-property (point) 'syntax-table) c-<-as-paren-syntax) ; should always be true. - (c-unmark-<->-as-paren (point))) - (c-unmark-<->-as-paren pos)))) + (c-unmark-<->-as-paren (point)) + (c-truncate-lit-pos-cache (point))) + (c-unmark-<->-as-paren pos) + (c-truncate-lit-pos-cache pos)))) (defun c-clear-<>-pair-props (&optional pos) ;; POS (default point) is at a < or > character. If it has an @@ -6919,7 +6923,8 @@ comment at the start of cc-engine.el for more info." (equal (c-get-char-property (1- (point)) 'syntax-table) c->-as-paren-syntax)) ; should always be true. (c-unmark-<->-as-paren (1- (point))) - (c-unmark-<->-as-paren pos)) + (c-unmark-<->-as-paren pos) + (c-truncate-lit-pos-cache pos)) t))) (defun c-clear->-pair-props-if-match-before (lim &optional pos) @@ -6940,6 +6945,7 @@ comment at the start of cc-engine.el for more info." (equal (c-get-char-property (point) 'syntax-table) c-<-as-paren-syntax)) ; should always be true. (c-unmark-<->-as-paren (point)) + (c-truncate-lit-pos-cache (point)) (c-unmark-<->-as-paren pos)) t))) @@ -7980,13 +7986,14 @@ comment at the start of cc-engine.el for more info." ;; bracket arglist. It's propagated through the return value ;; on successful completion. (c-record-found-types c-record-found-types) + (syntax-table-prop-on-< (c-get-char-property (point) 'syntax-table)) ;; List that collects the positions after the argument ;; separating ',' in the arglist. arg-start-pos) ;; If the '<' has paren open syntax then we've marked it as an angle ;; bracket arglist before, so skip to the end. (if (and (not c-parse-and-markup-<>-arglists) - (c-get-char-property (point) 'syntax-table)) + syntax-table-prop-on-<) (progn (forward-char) @@ -8071,8 +8078,20 @@ comment at the start of cc-engine.el for more info." (c-put-c-type-property (1- (car arg-start-pos)) 'c-<>-arg-sep) (setq arg-start-pos (cdr arg-start-pos))) + (when (and (not syntax-table-prop-on-<) + (c-get-char-property (1- (point)) + 'syntax-table)) + ;; Clear the now spuriously matching < of its + ;; syntax-table property. This could happen on + ;; inserting "_cast" into "static <" with C-y. + (save-excursion + (and (c-go-list-backward) + (eq (char-after) ?<) + (c-truncate-lit-pos-cache (point)) + (c-unmark-<->-as-paren (point))))) (c-mark-<-as-paren start) - (c-mark->-as-paren (1- (point)))) + (c-mark->-as-paren (1- (point))) + (c-truncate-lit-pos-cache start)) (setq res t) nil)) ; Exit the loop. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index acdb72fb7b..86627d9502 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2719,7 +2719,8 @@ if this isn't nil." `c-recognize-<>-arglists' for details. That language constant is assumed to be set if this isn't nil." t nil - c++ '("template") + c++ '("template" "const_cast" "dynamic_cast" "reinterpret_cast" + "static_cast") idl '("fixed" "string" "wstring")) (c-lang-defconst c-<>-sexp-kwds commit b8f9e58ef72402e69a1f0960816184d52e5d2d29 Author: Stefan Monnier Date: Sat Jun 26 12:29:52 2021 -0400 * lisp/minibuffer.el (completion-in-region--single-word): Simplify Remove redundant args `collection` and `predicate` which were always equal to `minibuffer-completion-table` and `minibuffer-completion-predicate` anyway. (minibuffer-complete-word): * lisp/emacs-lisp/crm.el (crm-complete-word): Simplify accordingly. diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index e106815817..d24ea355a5 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -183,8 +183,7 @@ Return t if the current element is now a valid match; otherwise return nil." Like `minibuffer-complete-word' but for `completing-read-multiple'." (interactive) (crm--completion-command beg end - (completion-in-region--single-word - beg end minibuffer-completion-table minibuffer-completion-predicate))) + (completion-in-region--single-word beg end))) (defun crm-complete-and-exit () "If all of the minibuffer elements are valid completions then exit. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 157ed617b0..71a2177c9b 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1790,17 +1790,12 @@ is added, provided that matches some possible completion. Return nil if there is no valid completion, else t." (interactive) (completion-in-region--single-word - (minibuffer--completion-prompt-end) (point-max) - minibuffer-completion-table minibuffer-completion-predicate)) - -(defun completion-in-region--single-word (beg end collection - &optional predicate) - (let ((minibuffer-completion-table collection) - (minibuffer-completion-predicate predicate)) - (pcase (completion--do-completion beg end - #'completion--try-word-completion) + (minibuffer--completion-prompt-end) (point-max))) + +(defun completion-in-region--single-word (beg end) + (pcase (completion--do-completion beg end #'completion--try-word-completion) (#b000 nil) - (_ t)))) + (_ t))) (defface completions-annotations '((t :inherit (italic shadow))) "Face to use for annotations in the *Completions* buffer.") commit db3767e8db132364dc7a412e1b13ae7bda0c0767 Author: Stefan Monnier Date: Sat Jun 26 12:22:22 2021 -0400 * lisp/minibuffer.el (minibuffer--completion-prompt-end): Rename diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index b106fd11a9..157ed617b0 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -882,7 +882,7 @@ If the current buffer is not a minibuffer, erase its entire contents." ;; is on, the field doesn't cover the entire minibuffer contents. (delete-region (minibuffer-prompt-end) (point-max))) -(defun completion--prompt-end () +(defun minibuffer--completion-prompt-end () (let ((end (minibuffer-prompt-end))) (if (< (point) end) (user-error "Can't complete in prompt") @@ -1355,7 +1355,7 @@ If no characters can be completed, display a list of possible completions. If you repeat this command after it displayed such a list, scroll the window of possible completions." (interactive) - (completion-in-region (completion--prompt-end) (point-max) + (completion-in-region (minibuffer--completion-prompt-end) (point-max) minibuffer-completion-table minibuffer-completion-predicate)) @@ -1535,7 +1535,7 @@ Remove completion BASE prefix string from history elements." (unless completion-cycling (minibuffer-force-complete nil nil 'dont-cycle)) (completion--complete-and-exit - (completion--prompt-end) (point-max) #'exit-minibuffer + (minibuffer--completion-prompt-end) (point-max) #'exit-minibuffer ;; If the previous completion completed to an element which fails ;; test-completion, then we shouldn't exit, but that should be rare. (lambda () @@ -1553,7 +1553,7 @@ DONT-CYCLE tells the function not to setup cycling." ;; FIXME: Need to deal with the extra-size issue here as well. ;; FIXME: ~/src/emacs/t/lisp/minibuffer.el completes to ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. - (let* ((start (copy-marker (or start (completion--prompt-end)))) + (let* ((start (copy-marker (or start (minibuffer--completion-prompt-end)))) (end (or end (point-max))) ;; (md (completion--field-metadata start)) (all (completion-all-sorted-completions start end)) @@ -1624,7 +1624,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', `minibuffer-confirm-exit-commands', and accept the input otherwise." (interactive) - (completion-complete-and-exit (completion--prompt-end) (point-max) + (completion-complete-and-exit (minibuffer--completion-prompt-end) (point-max) #'exit-minibuffer)) (defun completion-complete-and-exit (beg end exit-function) @@ -1790,7 +1790,7 @@ is added, provided that matches some possible completion. Return nil if there is no valid completion, else t." (interactive) (completion-in-region--single-word - (completion--prompt-end) (point-max) + (minibuffer--completion-prompt-end) (point-max) minibuffer-completion-table minibuffer-completion-predicate)) (defun completion-in-region--single-word (beg end collection @@ -2164,7 +2164,7 @@ variables.") "Display a list of possible completions of the current minibuffer contents." (interactive) (message "Making completion list...") - (let* ((start (or start (completion--prompt-end))) + (let* ((start (or start (minibuffer--completion-prompt-end))) (end (or end (point-max))) (string (buffer-substring start end)) (md (completion--field-metadata start)) commit 73663d14cfb3923dc57fab0043f7b1aa3a488407 Author: Stefan Monnier Date: Sat Jun 26 12:20:11 2021 -0400 * lisp/emacs-lisp/cl-macs.el: Fix test regression (cl--alist-to-plist): New function. (cl-struct-slot-info): Use it. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index a59d42e673..cff4368940 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3276,6 +3276,13 @@ STRUCT-TYPE is a symbol naming a struct type. Return `record', (declare (side-effect-free t) (pure t)) (cl--struct-class-type (cl--struct-get-class struct-type))) +(defun cl--alist-to-plist (alist) + (let ((res '())) + (dolist (x alist) + (push (car x) res) + (push (cdr x) res)) + (nreverse res))) + (defun cl-struct-slot-info (struct-type) "Return a list of slot names of struct STRUCT-TYPE. Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a @@ -3293,7 +3300,7 @@ slots skipped by :initial-offset may appear in the list." ,(cl--slot-descriptor-initform slot) ,@(if (not (eq (cl--slot-descriptor-type slot) t)) `(:type ,(cl--slot-descriptor-type slot))) - ,@(cl--slot-descriptor-props slot)) + ,@(cl--alist-to-plist (cl--slot-descriptor-props slot))) descs))) (nreverse descs))) commit d4561201891a53b7536fae98862b04535a1489c4 Author: Michael Albinus Date: Sat Jun 26 16:26:02 2021 +0200 Fix Tramp bug#49229 * lisp/net/tramp.el (tramp-file-name-handler): Drop possible volume letter when `expand-file-name' is called with a local absolute file name as first argument. (Bug#49229) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0f15e4a20b..c3b088aebb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2610,7 +2610,14 @@ Fall back to normal file name handler if no Tramp file name handler exists." ;; When `tramp-mode' is not enabled, or the file name is quoted, ;; we don't do anything. - (tramp-run-real-handler operation args)))) + ;; When operation is `expand-file-name', and the first argument + ;; is a local absolute file name, we end also here. Handle the + ;; MS Windows case. + (funcall + (if (and (eq operation 'expand-file-name) + (not (string-match-p "\\`[[:alpha:]]:/" (car args)))) + #'tramp-drop-volume-letter #'identity) + (tramp-run-real-handler operation args))))) (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler for OPERATION and ARGS. commit 1ed811a9edeca03f719376e8001c73046be5b1a2 Author: Stefan Monnier Date: Sat Jun 26 09:38:21 2021 -0400 * lisp/minibuffer.el (completion--prompt-end): New function (bug#30668) (minibuffer-complete, minibuffer-force-complete-and-exit) (minibuffer-force-complete, minibuffer-complete-and-exit) (minibuffer-complete-word, minibuffer-completion-help): Use it. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d09a348211..b106fd11a9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -882,6 +882,12 @@ If the current buffer is not a minibuffer, erase its entire contents." ;; is on, the field doesn't cover the entire minibuffer contents. (delete-region (minibuffer-prompt-end) (point-max))) +(defun completion--prompt-end () + (let ((end (minibuffer-prompt-end))) + (if (< (point) end) + (user-error "Can't complete in prompt") + end))) + (defvar completion-show-inline-help t "If non-nil, print helpful inline messages during completion.") @@ -1349,10 +1355,9 @@ If no characters can be completed, display a list of possible completions. If you repeat this command after it displayed such a list, scroll the window of possible completions." (interactive) - (when (<= (minibuffer-prompt-end) (point)) - (completion-in-region (minibuffer-prompt-end) (point-max) - minibuffer-completion-table - minibuffer-completion-predicate))) + (completion-in-region (completion--prompt-end) (point-max) + minibuffer-completion-table + minibuffer-completion-predicate)) (defun completion--in-region-1 (beg end) ;; If the previous command was not this, @@ -1530,7 +1535,7 @@ Remove completion BASE prefix string from history elements." (unless completion-cycling (minibuffer-force-complete nil nil 'dont-cycle)) (completion--complete-and-exit - (minibuffer-prompt-end) (point-max) #'exit-minibuffer + (completion--prompt-end) (point-max) #'exit-minibuffer ;; If the previous completion completed to an element which fails ;; test-completion, then we shouldn't exit, but that should be rare. (lambda () @@ -1548,7 +1553,7 @@ DONT-CYCLE tells the function not to setup cycling." ;; FIXME: Need to deal with the extra-size issue here as well. ;; FIXME: ~/src/emacs/t/lisp/minibuffer.el completes to ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. - (let* ((start (copy-marker (or start (minibuffer-prompt-end)))) + (let* ((start (copy-marker (or start (completion--prompt-end)))) (end (or end (point-max))) ;; (md (completion--field-metadata start)) (all (completion-all-sorted-completions start end)) @@ -1619,7 +1624,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', `minibuffer-confirm-exit-commands', and accept the input otherwise." (interactive) - (completion-complete-and-exit (minibuffer-prompt-end) (point-max) + (completion-complete-and-exit (completion--prompt-end) (point-max) #'exit-minibuffer)) (defun completion-complete-and-exit (beg end exit-function) @@ -1785,7 +1790,7 @@ is added, provided that matches some possible completion. Return nil if there is no valid completion, else t." (interactive) (completion-in-region--single-word - (minibuffer-prompt-end) (point-max) + (completion--prompt-end) (point-max) minibuffer-completion-table minibuffer-completion-predicate)) (defun completion-in-region--single-word (beg end collection @@ -2159,7 +2164,7 @@ variables.") "Display a list of possible completions of the current minibuffer contents." (interactive) (message "Making completion list...") - (let* ((start (or start (minibuffer-prompt-end))) + (let* ((start (or start (completion--prompt-end))) (end (or end (point-max))) (string (buffer-substring start end)) (md (completion--field-metadata start)) commit ecf7e8b20ea095bd1232175160c3521ee299c069 Author: Alan Third Date: Sat Jun 26 12:46:43 2021 +0100 Fix NS self-contained build configuration * configure.ac: When rebuilding epaths.h for NS check that we're actually doing an NS build first. diff --git a/configure.ac b/configure.ac index 92527056b9..c8920d877e 100644 --- a/configure.ac +++ b/configure.ac @@ -6020,12 +6020,12 @@ dnl the use of force in the 'epaths-force' rule in Makefile.in. AC_CONFIG_COMMANDS([src/epaths.h], [ if test "${opsys}" = "mingw32"; then ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-w32 -elif test "$EN_NS_SELF_CONTAINED" = "yes"; then +elif test "$HAVE_NS" = "yes" && test "$EN_NS_SELF_CONTAINED" = "yes"; then ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-ns-self-contained else ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force fi || AC_MSG_ERROR(['src/epaths.h' could not be made.]) -], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys" +], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys" HAVE_NS="$HAVE_NS" EN_NS_SELF_CONTAINED="$EN_NS_SELF_CONTAINED"]) dnl NB we have to cheat and use the ac_... version because abs_top_srcdir commit a0f060939456f3680823e34f430e482fcde2f5dd Author: Eli Zaretskii Date: Sat Jun 26 12:46:39 2021 +0300 ; * src/lread.c (load_path_default): Remove unused variable. diff --git a/src/lread.c b/src/lread.c index 4617ffd626..a6c2db5d99 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4769,7 +4769,6 @@ load_path_default (void) return decode_env_path (0, PATH_DUMPLOADSEARCH, 0); Lisp_Object lpath = Qnil; - const char *loadpath = NULL; lpath = decode_env_path (0, PATH_LOADSEARCH, 0); commit 5dd2d50f3d5e65b85c87da86e2e8a6d087fe5767 Author: Alan Third Date: Wed Jun 16 21:28:10 2021 +0100 Fix NS native compilation builds * Makefile.in (ns_applibexecdir): (ns_applibdir): (ns_appdir): New variables. (.PHONY): Include new rule. (epaths-force-ns-self-contained): Remove the app bundle directory from all paths. * configure.ac (NS_SELF_CONTAINED): Set the default site-lisp directory instead of hard-coding it in the ObjC code, and use the new epaths generating make rule. * src/callproc.c (init_callproc_1): (init_callproc): Remove all the NS specific code as the special cases are now handled by decode_env_path. * src/emacs.c (load_pdump): (decode_env_path): Use ns_relocate to find the correct directory after relocation. * src/lread.c (load_path_default): Remove all the NS specific code as the special cases are now handled by decode_env_path. * src/nsterm.h: Update function definitions. * src/nsterm.m (ns_etc_directory): (ns_exec_path): (ns_load_path): Remove functions that are no longer needed. (ns_relocate): New function to calculate paths within the NS app bundle. * nextstep/Makefile.in (ns_applibexecdir): New variable, and update anything relying on the libexec location. diff --git a/Makefile.in b/Makefile.in index b750288023..420cb544a4 100644 --- a/Makefile.in +++ b/Makefile.in @@ -106,8 +106,11 @@ USE_STARTUP_NOTIFICATION = @USE_STARTUP_NOTIFICATION@ # Location to install Emacs.app under GNUstep / macOS. # Later values may use these. +ns_appdir=@ns_appdir@ ns_appbindir=@ns_appbindir@ +ns_applibexecdir=@ns_applibexecdir@ ns_appresdir=@ns_appresdir@ +ns_applibdir=@ns_applibdir@ # Either yes or no depending on whether this is a relocatable Emacs.app. ns_self_contained=@ns_self_contained@ @@ -330,12 +333,12 @@ BIN_DESTDIR='$(DESTDIR)${bindir}/' ELN_DESTDIR = $(DESTDIR)${libdir}/emacs/${version}/ else BIN_DESTDIR='${ns_appbindir}/' -ELN_DESTDIR = ${ns_appresdir}/ +ELN_DESTDIR = ${ns_applibdir}/emacs/${version}/ endif all: ${SUBDIR} info -.PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 etc-emacsver +.PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 epaths-force-ns-self-contained etc-emacsver # If configure were to just generate emacsver.tex from emacsver.tex.in # in the normal way, the timestamp of emacsver.tex would always be @@ -404,6 +407,17 @@ epaths-force-w32: -e "/^.*#/s|@SRC@|$${w32srcdir}|g") && \ ${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h +# A NextStep style app bundle is relocatable, so instead of +# hard-coding paths try to generate them at run-time. +# +# The paths are mostly the same, and the bundle paths are different +# between macOS and GNUstep, so just replace any references to the app +# bundle root itself with the relative path. +epaths-force-ns-self-contained: epaths-force + @(sed < ${srcdir}/src/epaths.h > epaths.h.$$$$ \ + -e 's;${ns_appdir}/;;') && \ + ${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h + lib-src src: $(NTDIR) lib src: lib-src diff --git a/configure.ac b/configure.ac index 830f33844b..92527056b9 100644 --- a/configure.ac +++ b/configure.ac @@ -1891,10 +1891,11 @@ if test "${with_ns}" != no; then # so avoid NS_IMPL_COCOA if macuvs.h is absent. # Even a headless Emacs can build macuvs.h, so this should let you bootstrap. if test "${opsys}" = darwin && test -f "$srcdir/src/macuvs.h"; then - lispdirrel=Contents/Resources/lisp NS_IMPL_COCOA=yes ns_appdir=`pwd`/nextstep/Emacs.app ns_appbindir=${ns_appdir}/Contents/MacOS + ns_applibexecdir=${ns_appdir}/Contents/MacOS/libexec + ns_applibdir=${ns_appdir}/Contents/MacOS/lib ns_appresdir=${ns_appdir}/Contents/Resources ns_appsrc=Cocoa/Emacs.base ns_fontfile=macfont.o @@ -1952,6 +1953,8 @@ fail; if test $NS_IMPL_GNUSTEP = yes; then ns_appdir=`pwd`/nextstep/Emacs.app ns_appbindir=${ns_appdir} + ns_applibexecdir=${ns_appdir}/libexec + ns_applibdir=${ns_appdir}/lib ns_appresdir=${ns_appdir}/Resources ns_appsrc=GNUstep/Emacs.base ns_fontfile=nsfont.o @@ -2008,12 +2011,13 @@ if test "${HAVE_NS}" = yes; then window_system=nextstep # set up packaging dirs if test "${EN_NS_SELF_CONTAINED}" = yes; then + AC_DEFINE(NS_SELF_CONTAINED, 1, [Build an NS bundled app]) ns_self_contained=yes prefix=${ns_appresdir} exec_prefix=${ns_appbindir} dnl This one isn't really used, only archlibdir is. - libexecdir="\${ns_appbindir}/libexec" - archlibdir="\${ns_appbindir}/libexec" + libexecdir="\${ns_applibexecdir}" + archlibdir="\${ns_applibexecdir}" etcdocdir="\${ns_appresdir}/etc" etcdir="\${ns_appresdir}/etc" dnl FIXME maybe set datarootdir instead. @@ -2021,7 +2025,7 @@ if test "${HAVE_NS}" = yes; then infodir="\${ns_appresdir}/info" mandir="\${ns_appresdir}/man" lispdir="\${ns_appresdir}/lisp" - test "$locallisppathset" = no && locallisppath="" + test "$locallisppathset" = no && locallisppath="\${ns_appresdir}/site-lisp" INSTALL_ARCH_INDEP_EXTRA= fi @@ -5414,6 +5418,8 @@ AC_SUBST(CFLAGS) AC_SUBST(X_TOOLKIT_TYPE) AC_SUBST(ns_appdir) AC_SUBST(ns_appbindir) +AC_SUBST(ns_applibexecdir) +AC_SUBST(ns_applibdir) AC_SUBST(ns_appresdir) AC_SUBST(ns_appsrc) AC_SUBST(GNU_OBJC_CFLAGS) @@ -6014,10 +6020,13 @@ dnl the use of force in the 'epaths-force' rule in Makefile.in. AC_CONFIG_COMMANDS([src/epaths.h], [ if test "${opsys}" = "mingw32"; then ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-w32 +elif test "$EN_NS_SELF_CONTAINED" = "yes"; then + ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-ns-self-contained else ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force fi || AC_MSG_ERROR(['src/epaths.h' could not be made.]) -], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys"]) +], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys" + EN_NS_SELF_CONTAINED="$EN_NS_SELF_CONTAINED"]) dnl NB we have to cheat and use the ac_... version because abs_top_srcdir dnl is not yet set, sigh. Or we could use ../$srcdir/src/.gdbinit, diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in index 3168fee76c..42b2ab2715 100644 --- a/nextstep/Makefile.in +++ b/nextstep/Makefile.in @@ -36,6 +36,7 @@ MKDIR_P = @MKDIR_P@ ns_appdir = @ns_appdir@ ## GNUstep: ns_appdir; macOS: ns_appdir/Contents/MacOS ns_appbindir = @ns_appbindir@ +ns_applibexecdir = @ns_applibexecdir@ ## GNUstep/Emacs.base or Cocoa/Emacs.base. ns_appsrc = @ns_appsrc@ ## GNUstep: GNUstep/Emacs.base/Resources/Info-gnustep.plist @@ -44,7 +45,7 @@ ns_check_file = @ns_appdir@/@ns_check_file@ .PHONY: all -all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_appbindir}/Emacs.pdmp +all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_applibexecdir}/Emacs.pdmp ${ns_check_file} ${ns_appdir}: ${srcdir}/${ns_appsrc} ${ns_appsrc} rm -rf ${ns_appdir} @@ -63,8 +64,10 @@ ${ns_appbindir}/Emacs: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT} ${MKDIR_P} ${ns_appbindir} cp -f ../src/emacs${EXEEXT} $@ -${ns_appbindir}/Emacs.pdmp: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT}.pdmp - ${MKDIR_P} ${ns_appbindir} +# FIXME: Don't install the dump file into the app bundle when +# self-contained install is disabled. +${ns_applibexecdir}/Emacs.pdmp: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT}.pdmp + ${MKDIR_P} ${ns_applibexecdir} cp -f ../src/emacs${EXEEXT}.pdmp $@ .PHONY: FORCE @@ -85,9 +88,8 @@ links: ../src/emacs${EXEEXT} ln -s $(top_srcdir_abs)/info ${ns_appdir}/Contents/Resources ${MKDIR_P} ${ns_appbindir} ln -s $(abs_top_builddir)/src/emacs${EXEEXT} ${ns_appbindir}/Emacs - ln -s $(abs_top_builddir)/src/emacs${EXEEXT}.pdmp ${ns_appbindir}/Emacs.pdmp ln -s $(abs_top_builddir)/lib-src ${ns_appbindir}/bin - ln -s $(abs_top_builddir)/lib-src ${ns_appbindir}/libexec + ln -s $(abs_top_builddir)/lib-src ${ns_applibexecdir} ${MKDIR_P} ${ns_appdir}/Contents/Resources/etc for f in $(shell cd $(top_srcdir_abs)/etc; ls); do ln -s $(top_srcdir_abs)/etc/$$f ${ns_appdir}/Contents/Resources/etc; done ln -s $(abs_top_builddir)/etc/DOC ${ns_appdir}/Contents/Resources/etc diff --git a/src/Makefile.in b/src/Makefile.in index 79cddb35b5..22c7aeed5c 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -55,7 +55,7 @@ lwlibdir = ../lwlib # Configuration files for .o files to depend on. config_h = config.h $(srcdir)/conf_post.h -## ns-app if HAVE_NS, else empty. +## ns-app if NS self contained app, else empty. OTHER_FILES = @OTHER_FILES@ ## Flags to pass for profiling builds diff --git a/src/callproc.c b/src/callproc.c index e44e243680..aabc39313b 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1661,32 +1661,15 @@ make_environment_block (Lisp_Object current_dir) void init_callproc_1 (void) { -#ifdef HAVE_NS - const char *etc_dir = ns_etc_directory (); - const char *path_exec = ns_exec_path (); -#endif - - Vdata_directory = decode_env_path ("EMACSDATA", -#ifdef HAVE_NS - etc_dir ? etc_dir : -#endif - PATH_DATA, 0); + Vdata_directory = decode_env_path ("EMACSDATA", PATH_DATA, 0); Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory)); - Vdoc_directory = decode_env_path ("EMACSDOC", -#ifdef HAVE_NS - etc_dir ? etc_dir : -#endif - PATH_DOC, 0); + Vdoc_directory = decode_env_path ("EMACSDOC", PATH_DOC, 0); Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory)); /* Check the EMACSPATH environment variable, defaulting to the PATH_EXEC path from epaths.h. */ - Vexec_path = decode_env_path ("EMACSPATH", -#ifdef HAVE_NS - path_exec ? path_exec : -#endif - PATH_EXEC, 0); + Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC, 0); Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); /* FIXME? For ns, path_exec should go at the front? */ Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path); @@ -1701,10 +1684,6 @@ init_callproc (void) char *sh; Lisp_Object tempdir; -#ifdef HAVE_NS - if (data_dir == 0) - data_dir = ns_etc_directory () != 0; -#endif if (!NILP (Vinstallation_directory)) { @@ -1716,15 +1695,8 @@ init_callproc (void) /* MSDOS uses wrapped binaries, so don't do this. */ if (NILP (Fmember (tem, Vexec_path))) { -#ifdef HAVE_NS - const char *path_exec = ns_exec_path (); -#endif /* Running uninstalled, so default to tem rather than PATH_EXEC. */ - Vexec_path = decode_env_path ("EMACSPATH", -#ifdef HAVE_NS - path_exec ? path_exec : -#endif - SSDATA (tem), 0); + Vexec_path = decode_env_path ("EMACSPATH", SSDATA (tem), 0); Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path); } diff --git a/src/emacs.c b/src/emacs.c index 60a57a693c..b7982ece64 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -835,7 +835,13 @@ load_pdump (int argc, char **argv) NULL #endif ; - const char *argv0_base = "emacs"; + const char *argv0_base = +#ifdef NS_SELF_CONTAINED + "Emacs" +#else + "emacs" +#endif + ; /* TODO: maybe more thoroughly scrub process environment in order to make this use case (loading a dump file in an unexeced emacs) @@ -912,6 +918,8 @@ load_pdump (int argc, char **argv) /* On MS-Windows, PATH_EXEC normally starts with a literal "%emacs_dir%", so it will never work without some tweaking. */ path_exec = w32_relocate (path_exec); +#elif defined (HAVE_NS) + path_exec = ns_relocate (path_exec); #endif /* Look for "emacs.pdmp" in PATH_EXEC. We hardcode "emacs" in @@ -929,6 +937,7 @@ load_pdump (int argc, char **argv) } sprintf (dump_file, "%s%c%s%s", path_exec, DIRECTORY_SEP, argv0_base, suffix); +#if !defined (NS_SELF_CONTAINED) /* Assume the Emacs binary lives in a sibling directory as set up by the default installation configuration. */ const char *go_up = "../../../../bin/"; @@ -943,6 +952,7 @@ load_pdump (int argc, char **argv) sprintf (emacs_executable, "%s%c%s%s%s", path_exec, DIRECTORY_SEP, go_up, argv0_base, strip_suffix ? strip_suffix : ""); +#endif result = pdumper_load (dump_file, emacs_executable); if (result == PDUMPER_LOAD_FILE_NOT_FOUND) @@ -2960,7 +2970,11 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) path = 0; if (!path) { +#ifdef NS_SELF_CONTAINED + path = ns_relocate (defalt); +#else path = defalt; +#endif #ifdef WINDOWSNT defaulted = 1; #endif diff --git a/src/lread.c b/src/lread.c index 0b33fd0f25..4617ffd626 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4769,14 +4769,9 @@ load_path_default (void) return decode_env_path (0, PATH_DUMPLOADSEARCH, 0); Lisp_Object lpath = Qnil; - const char *normal = PATH_LOADSEARCH; const char *loadpath = NULL; -#ifdef HAVE_NS - loadpath = ns_load_path (); -#endif - - lpath = decode_env_path (0, loadpath ? loadpath : normal, 0); + lpath = decode_env_path (0, PATH_LOADSEARCH, 0); if (!NILP (Vinstallation_directory)) { diff --git a/src/nsterm.h b/src/nsterm.h index f64354b8a7..b29e76cc63 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1190,9 +1190,7 @@ extern void ns_run_ascript (void); #define NSAPP_DATA2_RUNFILEDIALOG 11 extern void ns_run_file_dialog (void); -extern const char *ns_etc_directory (void); -extern const char *ns_exec_path (void); -extern const char *ns_load_path (void); +extern const char *ns_relocate (const char *epath); extern void syms_of_nsterm (void); extern void syms_of_nsfns (void); extern void syms_of_nsmenu (void); diff --git a/src/nsterm.m b/src/nsterm.m index e81a4cbc0d..8497138039 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -499,118 +499,35 @@ - (NSColor *)colorUsingDefaultColorSpace const char * -ns_etc_directory (void) -/* If running as a self-contained app bundle, return as a string the - filename of the etc directory, if present; else nil. */ -{ - NSBundle *bundle = [NSBundle mainBundle]; - NSString *resourceDir = [bundle resourcePath]; - NSString *resourcePath; - NSFileManager *fileManager = [NSFileManager defaultManager]; - BOOL isDir; +ns_relocate (const char *epath) +/* If we're running in a self-contained app bundle some hard-coded + paths are relative to the root of the bundle, so work out the full + path. - resourcePath = [resourceDir stringByAppendingPathComponent: @"etc"]; - if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir]) - { - if (isDir) return [resourcePath UTF8String]; - } - return NULL; -} - - -const char * -ns_exec_path (void) -/* If running as a self-contained app bundle, return as a path string - the filenames of the libexec and bin directories, ie libexec:bin. - Otherwise, return nil. - Normally, Emacs does not add its own bin/ directory to the PATH. - However, a self-contained NS build has a different layout, with - bin/ and libexec/ subdirectories in the directory that contains - Emacs.app itself. - We put libexec first, because init_callproc_1 uses the first - element to initialize exec-directory. An alternative would be - for init_callproc to check for invocation-directory/libexec. -*/ + FIXME: I think this should be able to handle cases where multiple + directories are separated by colons. */ { +#ifdef NS_SELF_CONTAINED NSBundle *bundle = [NSBundle mainBundle]; - NSString *resourceDir = [bundle resourcePath]; - NSString *binDir = [bundle bundlePath]; - NSString *resourcePath, *resourcePaths; - NSRange range; - NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR]; + NSString *root = [bundle bundlePath]; + NSString *original = [NSString stringWithUTF8String:epath]; + NSString *fixedPath = [NSString pathWithComponents:@[root, original]]; NSFileManager *fileManager = [NSFileManager defaultManager]; - NSArray *paths; - NSEnumerator *pathEnum; - BOOL isDir; - range = [resourceDir rangeOfString: @"Contents"]; - if (range.location != NSNotFound) - { - binDir = [binDir stringByAppendingPathComponent: @"Contents"]; -#ifdef NS_IMPL_COCOA - binDir = [binDir stringByAppendingPathComponent: @"MacOS"]; -#endif - } + if (![original isAbsolutePath] + && [fileManager fileExistsAtPath:fixedPath isDirectory:NULL]) + return [fixedPath UTF8String]; - paths = [binDir stringsByAppendingPaths: - [NSArray arrayWithObjects: @"libexec", @"bin", nil]]; - pathEnum = [paths objectEnumerator]; - resourcePaths = @""; + /* If we reach here either the path is absolute and therefore we + don't need to complete it, or we're unable to relocate the + file/directory. If it's the latter it may be because the user is + trying to use a bundled app as though it's a Unix style install + and we have no way to guess what was intended, so return the + original string unaltered. */ - while ((resourcePath = [pathEnum nextObject])) - { - if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir]) - if (isDir) - { - if ([resourcePaths length] > 0) - resourcePaths - = [resourcePaths stringByAppendingString: pathSeparator]; - resourcePaths - = [resourcePaths stringByAppendingString: resourcePath]; - } - } - if ([resourcePaths length] > 0) return [resourcePaths UTF8String]; - - return NULL; -} - - -const char * -ns_load_path (void) -/* If running as a self-contained app bundle, return as a path string - the filenames of the site-lisp and lisp directories. - Ie, site-lisp:lisp. Otherwise, return nil. */ -{ - NSBundle *bundle = [NSBundle mainBundle]; - NSString *resourceDir = [bundle resourcePath]; - NSString *resourcePath, *resourcePaths; - NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR]; - NSFileManager *fileManager = [NSFileManager defaultManager]; - BOOL isDir; - NSArray *paths = [resourceDir stringsByAppendingPaths: - [NSArray arrayWithObjects: - @"site-lisp", @"lisp", nil]]; - NSEnumerator *pathEnum = [paths objectEnumerator]; - resourcePaths = @""; - - /* Hack to skip site-lisp. */ - if (no_site_lisp) resourcePath = [pathEnum nextObject]; - - while ((resourcePath = [pathEnum nextObject])) - { - if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir]) - if (isDir) - { - if ([resourcePaths length] > 0) - resourcePaths - = [resourcePaths stringByAppendingString: pathSeparator]; - resourcePaths - = [resourcePaths stringByAppendingString: resourcePath]; - } - } - if ([resourcePaths length] > 0) return [resourcePaths UTF8String]; +#endif - return NULL; + return epath; } commit 4d63a033a726a8da33bda8d18a503e88bfb794fb Author: Eric Abrahamsen Date: Fri Jun 25 20:42:16 2021 -0700 Small improvements to handling of IMAP mark search * lisp/gnus/gnus-search.el (gnus-search-imap-handle-flag): Use a KEYWORD search for any mark starting with a "$", so "mark:$hasattachment" goes through as "KEYWORD $hasattachment". diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index fc9f8684f6..70bde264c1 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1278,17 +1278,23 @@ elements are present." str))) (defun gnus-search-imap-handle-flag (flag) - "Make sure string FLAG is something IMAP will recognize." - ;; What else? What about the KEYWORD search key? + "Adjust string FLAG to help IMAP recognize it. +If it's one of the RFC3501 flags, make sure it's upcased. +Otherwise, if FLAG starts with a \"$\", treat as a KEYWORD +search. Otherwise, drop the flag." (setq flag (pcase flag ("flag" "flagged") ("read" "seen") ("replied" "answered") (_ flag))) - (if (member flag '("seen" "answered" "deleted" "draft" "flagged")) - (upcase flag) - "")) + (cond + ((member flag '("seen" "answered" "deleted" "draft" "flagged" "recent")) + (upcase flag)) + ((string-prefix-p "$" flag) + (format "KEYWORD %s" flag)) + ;; TODO: Provide a user option to treat *all* marks as a KEYWORDs? + (t ""))) ;;; Methods for the indexed search engines. commit f2729dd8ee0cad67ea2ab0411526f9bc4a7b2c9a Author: Stefan Kangas Date: Fri Jun 25 22:09:06 2021 +0200 ; * etc/NEWS: Re-arrange two items. diff --git a/etc/NEWS b/etc/NEWS index 99096527cb..b9a9369049 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -117,6 +117,10 @@ filters. * Changes in Emacs 28.1 +** 'blink-cursor-mode' is now enabled by default regardless of the UI. +It used to be enabled when Emacs is started in GUI mode but not when started +in text mode. The cursor still only actually blinks in GUI frames. + +++ ** Etags now supports the Mercury programming language. See https://mercurylang.org. @@ -296,14 +300,6 @@ commands. The new keystrokes are 'C-x x g' ('revert-buffer'), ** Commands 'set-frame-width' and 'set-frame-height' can now get their input using the minibuffer. ---- -** New user option 'bookmark-menu-confirm-deletion'. -In Bookmark Menu mode, Emacs by default does not prompt for -confirmation when you type 'x' to execute the deletion of bookmarks -that have been marked for deletion. However, if this new option is -non-nil then Emacs will require confirmation with 'yes-or-no-p' before -deleting. - --- ** New help window when Emacs prompts before opening a large file. Commands like 'find-file' or 'visit-tags-table' ask to visit a file @@ -490,10 +486,6 @@ in seconds. This used to be named 'macroexp--warn-and-return' and has proved useful and well-behaved enough to lose the "internal" marker. -** 'blink-cursor-mode' is now enabled by default regardless of the UI. -It used to be enabled when Emacs is started in GUI mode but not when started -in text mode. The cursor still only actually blinks in GUI frames. - ** Bindat +++ @@ -1293,6 +1285,14 @@ the variables 'bookmark-bmenu-use-header-line' and If non-nil, setting a bookmark will colorize the current line with 'bookmark-face'. +--- +*** New user option 'bookmark-menu-confirm-deletion'. +In Bookmark Menu mode, Emacs by default does not prompt for +confirmation when you type 'x' to execute the deletion of bookmarks +that have been marked for deletion. However, if this new option is +non-nil then Emacs will require confirmation with 'yes-or-no-p' before +deleting. + ** Edebug *** Obsoletions commit 52528d6a162630a57ec0dd182295b4ce2c4c228d Author: Mattias Engdegård Date: Fri Jun 25 19:43:04 2021 +0200 Print newlines as \n instead of \12 in ERT results This makes test errors unquestionably more readable. The change also makes FF print as \f; other controls still use octal escapes. * lisp/emacs-lisp/ert.el (ert--pp-with-indentation-and-newline): Run `pp` with `pp-escape-newlines` set to `t`. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7de07bd6f5..50b45092ca 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1301,7 +1301,7 @@ empty string." "Pretty-print OBJECT, indenting it to the current column of point. Ensures a final newline is inserted." (let ((begin (point)) - (pp-escape-newlines nil) + (pp-escape-newlines t) (print-escape-control-characters t)) (pp object (current-buffer)) (unless (bolp) (insert "\n")) commit db491e07a2ae235edbf7e126510f428a33686096 Author: Stefan Kangas Date: Fri Jun 25 18:31:26 2021 +0200 ; * etc/NEWS: Fix typo. diff --git a/etc/NEWS b/etc/NEWS index 0001758b14..99096527cb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2135,7 +2135,7 @@ summaries will include the failing condition. ** Miscellaneous --- -*** `C-x M-x dig' will now prompt for a query type to use. +*** `C-u M-x dig' will now prompt for a query type to use. +++ *** rcirc now supports SASL authentication. commit 9e8d8e1a037b0f8d4f06dfd384c27a894f442de7 Author: Lars Ingebrigtsen Date: Fri Jun 25 17:16:28 2021 +0200 Make (find-face-definition 'default) work more reliably * lisp/emacs-lisp/find-func.el (find-function--defface): New function (bug#30230). (find-function-regexp-alist): Use it to skip past definitions inside comments and strings. diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 58876a45e1..7bc3e6b25f 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -123,10 +123,18 @@ should insert the feature name." :group 'xref :version "25.1") +(defun find-function--defface (symbol) + (catch 'found + (while (re-search-forward (format find-face-regexp symbol) nil t) + (unless (ppss-comment-or-string-start + (save-excursion (syntax-ppss (match-beginning 0)))) + ;; We're not in a comment or a string. + (throw 'found t))))) + (defvar find-function-regexp-alist '((nil . find-function-regexp) (defvar . find-variable-regexp) - (defface . find-face-regexp) + (defface . find-function--defface) (feature . find-feature-regexp) (defalias . find-alias-regexp)) "Alist mapping definition types into regexp variables. commit 553221fc557445b6599ab6e683451df2f11e62d0 Author: Lars Ingebrigtsen Date: Fri Jun 25 15:58:03 2021 +0200 Fix the name of the sorted minor mode map after previous change * lisp/bindings.el (mode-line-major-mode-keymap): Change the name of the minor mode menu items. diff --git a/lisp/bindings.el b/lisp/bindings.el index 6dce3588fc..06ba5d06e7 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -363,7 +363,7 @@ a menu, so this function is not useful for non-menu keymaps." :filter ,(lambda (_) (mouse-menu-major-mode-map)))) (define-key map [mode-line mouse-2] 'describe-mode) (bindings--define-key map [mode-line down-mouse-3] - `(menu-item "Menu Bar" ,mode-line-mode-menu + `(menu-item "Minor Modes" ,mode-line-mode-menu :filter bindings--sort-menu-keymap)) map) "\ Keymap to display on major mode.") commit 6e0bff0296b08fe96b7060f8d10eaa393fcb7bd4 Author: Eli Zaretskii Date: Fri Jun 25 16:52:48 2021 +0300 Fix race conditions between Lisp threads in GTK builds * src/xgselect.c (release_select_lock, acquire_select_lock) [GCC >= 4.7.0]: Use '__atomic' builtins to prevent races between threads in accessing 'threads_holding_glib_lock'. Reported by . (Bug#36609) diff --git a/src/xgselect.c b/src/xgselect.c index 0d91d55bad..92b118b955 100644 --- a/src/xgselect.c +++ b/src/xgselect.c @@ -34,12 +34,27 @@ static GMainContext *glib_main_context; void release_select_lock (void) { +#if GNUC_PREREQ (4, 7, 0) + if (__atomic_sub_fetch (&threads_holding_glib_lock, 1, __ATOMIC_ACQ_REL) == 0) + g_main_context_release (glib_main_context); +#else if (--threads_holding_glib_lock == 0) g_main_context_release (glib_main_context); +#endif } static void acquire_select_lock (GMainContext *context) { +#if GNUC_PREREQ (4, 7, 0) + if (__atomic_fetch_add (&threads_holding_glib_lock, 1, __ATOMIC_ACQ_REL) == 0) + { + glib_main_context = context; + while (!g_main_context_acquire (context)) + { + /* Spin. */ + } + } +#else if (threads_holding_glib_lock++ == 0) { glib_main_context = context; @@ -48,6 +63,7 @@ static void acquire_select_lock (GMainContext *context) /* Spin. */ } } +#endif } /* `xg_select' is a `pselect' replacement. Why do we need a separate function? commit 2fbe17c49ab8c413f5036e60ee31a56c3ed435da Author: Michael Albinus Date: Fri Jun 25 14:18:28 2021 +0200 Fix Tramp bug#49178 * lisp/net/tramp.el (tramp-handle-find-backup-file-name) (tramp-handle-make-auto-save-file-name): Adapt checks. (Bug#49178) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5284981961..0f15e4a20b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3648,17 +3648,17 @@ User is always nil." (cdr x)))) tramp-backup-directory-alist) backup-directory-alist)) - (uid (tramp-compat-file-attribute-user-id - (file-attributes filename 'integer))) result) (prog1 ;; Run plain `find-backup-file-name'. (setq result (tramp-run-real-handler #'find-backup-file-name (list filename))) ;; Protect against security hole. - (when (and (natnump uid) (zerop uid) + (when (and (not tramp-allow-unsafe-temporary-files) (file-in-directory-p (car result) temporary-file-directory) - (not tramp-allow-unsafe-temporary-files) + (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer)) + tramp-unknown-id-integer)) (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p @@ -5264,8 +5264,7 @@ this file, if that variable is non-nil." (auto-save-file-name-transforms (if (null tramp-auto-save-directory) auto-save-file-name-transforms)) - (uid (tramp-compat-file-attribute-user-id - (file-attributes buffer-file-name 'integer))) + (filename buffer-file-name) (buffer-file-name (if (null tramp-auto-save-directory) buffer-file-name @@ -5283,9 +5282,11 @@ this file, if that variable is non-nil." (prog1 ;; Run plain `make-auto-save-file-name'. (setq result (tramp-run-real-handler #'make-auto-save-file-name nil)) ;; Protect against security hole. - (when (and (natnump uid) (zerop uid) + (when (and (not tramp-allow-unsafe-temporary-files) (file-in-directory-p result temporary-file-directory) - (not tramp-allow-unsafe-temporary-files) + (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer)) + tramp-unknown-id-integer)) (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p commit 8b49e99504f7ba30abc90a31b02e2e230e818b75 Author: Juri Linkov Date: Fri Jun 25 12:38:27 2021 +0300 * lisp/tab-bar.el (tab-bar--define-keys): Fix global-mode-string (bug#49215) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index f3c2fb7ed9..41d565abd5 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -138,15 +138,12 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and (when (and (memq 'tab-bar-format-global tab-bar-format) (member '(global-mode-string ("" global-mode-string " ")) mode-line-misc-info)) - (setq mode-line-misc-info - (append '(global-mode-string - ("" (:eval (if (and tab-bar-mode - (memq 'tab-bar-format-global - tab-bar-format)) - "" global-mode-string)) - " ")) - (remove '(global-mode-string ("" global-mode-string " ")) - mode-line-misc-info))))) + (setf (alist-get 'global-mode-string mode-line-misc-info) + '(("" (:eval (if (and tab-bar-mode + (memq 'tab-bar-format-global + tab-bar-format)) + "" global-mode-string)) + " "))))) (defun tab-bar--undefine-keys () "Uninstall key bindings previously bound by `tab-bar--define-keys'." commit 19f2f2699499d87186c6f580e4ec79205d59c096 Author: Stephen Berman Date: Fri Jun 25 11:11:43 2021 +0200 Prevent Org mode from mistakenly changing Calendar keymap * lisp/org/org-compat.el (org--setup-calendar-bindings): Fix logic in test of 'org-agenda-diary-file' (bug#48199). diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 1f4e2e8308..b68e5b58fc 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -1151,8 +1151,8 @@ key." ((guard (not (lookup-key calendar-mode-map "c"))) (local-set-key "c" #'org-calendar-goto-agenda)) (_ nil)) - (unless (and (boundp 'org-agenda-diary-file) - (eq org-agenda-diary-file 'diary-file)) + (when (and (boundp 'org-agenda-diary-file) + (not (eq org-agenda-diary-file 'diary-file))) (local-set-key org-calendar-insert-diary-entry-key #'org-agenda-diary-entry))) commit 3c674ffcca90aa6eec30daf99f8b8f0efcbf5bad Author: Eli Zaretskii Date: Fri Jun 25 08:36:27 2021 +0300 Fix syntax-category of some punctuation characters * lisp/textmodes/text-mode.el (text-mode-syntax-table): Don't modify the global syntax-table just because we load text-mode.el. This happens at loadup time, and then affects the default syntax in all modes, not just in text-mode and its derivatives. (Bug#49214) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index ffeb9e64dd..74c6d412a6 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -49,7 +49,7 @@ (modify-syntax-entry ?' "w p" st) ;; UAX #29 says HEBREW PUNCTUATION GERESH behaves like a letter ;; for the purposes of finding word boundaries. - (modify-syntax-entry #x5f3 "w ") ; GERESH + (modify-syntax-entry #x5f3 "w " st) ; GERESH ;; UAX #29 says HEBREW PUNCTUATION GERSHAYIM should not be a word ;; boundary when surrounded by letters. Our infrastructure for ;; finding a word boundary doesn't support 3-character @@ -57,13 +57,13 @@ ;; character. This leaves a problem of having GERSHAYIM at the ;; beginning or end of a word, where it should be a boundary; ;; FIXME. - (modify-syntax-entry #x5f4 "w ") ; GERSHAYIM + (modify-syntax-entry #x5f4 "w " st) ; GERSHAYIM ;; These all should not be a word boundary when between letters, ;; according to UAX #29, so they again are prone to the same ;; problem as GERSHAYIM; FIXME. - (modify-syntax-entry #xb7 "w ") ; MIDDLE DOT - (modify-syntax-entry #x2027 "w ") ; HYPHENATION POINT - (modify-syntax-entry #xff1a "w ") ; FULLWIDTH COLON + (modify-syntax-entry #xb7 "w " st) ; MIDDLE DOT + (modify-syntax-entry #x2027 "w " st) ; HYPHENATION POINT + (modify-syntax-entry #xff1a "w " st) ; FULLWIDTH COLON st) "Syntax table used while in `text-mode'.") commit 1c10517f01d8c849aee6c1d203a890ee7a1c4393 Author: Stefan Monnier Date: Thu Jun 24 17:34:57 2021 -0400 * lisp/bindings.el (bindings--sort-menu-keymap): Add "menu" in its name (bindings--menu-item-string): Use `pcase`. diff --git a/lisp/bindings.el b/lisp/bindings.el index d63783a45d..6dce3588fc 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -332,15 +332,11 @@ Menu of mode operations in the mode line.") (defun bindings--menu-item-string (item) "Return the menu-item string for ITEM, or nil if not a menu-item." - (cond - ((not (consp item)) nil) ; Not a menu-item. - ((eq 'menu-item (car item)) - (eval (cadr item))) - ((stringp (car item)) - (car item)) - (t nil))) ; Not a menu-item either. - -(defun bindings--sort-keymap (map) + (pcase item + (`(menu-item ,name . ,_) (eval name t)) + (`(,(and (pred stringp) name) . ,_) name))) + +(defun bindings--sort-menu-keymap (map) "Sort the bindings in MAP in alphabetical order by menu-item string. The order of bindings in a keymap matters only when it is used as a menu, so this function is not useful for non-menu keymaps." @@ -368,7 +364,7 @@ a menu, so this function is not useful for non-menu keymaps." (define-key map [mode-line mouse-2] 'describe-mode) (bindings--define-key map [mode-line down-mouse-3] `(menu-item "Menu Bar" ,mode-line-mode-menu - :filter bindings--sort-keymap)) + :filter bindings--sort-menu-keymap)) map) "\ Keymap to display on major mode.") @@ -376,7 +372,7 @@ Keymap to display on major mode.") (let ((map (make-sparse-keymap)) (mode-menu-binding `(menu-item "Menu Bar" ,mode-line-mode-menu - :filter bindings--sort-keymap))) + :filter bindings--sort-menu-keymap))) (define-key map [mode-line down-mouse-1] 'mouse-minor-mode-menu) (define-key map [mode-line mouse-2] 'mode-line-minor-mode-help) (define-key map [mode-line down-mouse-3] mode-menu-binding) commit 3788d2237d4c65b67b95e33d1aca8d8b41780429 Author: Stefan Monnier Date: Thu Jun 24 17:32:20 2021 -0400 * lisp/emacs-lisp/cl-preloaded.el: Fix the format of props in slot-descs (cl--plist-remove): Remove. (cl--plist-to-alist): New function. (cl-struct-define): Use it to convert slots's properties to the format expected by `cl-slot-descriptor`. * lisp/emacs-lisp/cl-extra.el (cl--describe-class-slots): Revert last changes, not needed any more. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index c30349de6b..3840d13ecf 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -901,14 +901,8 @@ Outputs to the current buffer." (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) (cl-prin1-to-string (cl--slot-descriptor-type slot)) (cl-prin1-to-string (cl--slot-descriptor-initform slot)) - (let ((doc - ;; The props are an alist in a `defclass', - ;; but a plist when describing a `cl-defstruct'. - (if (consp (car (cl--slot-descriptor-props slot))) - (alist-get :documentation - (cl--slot-descriptor-props slot)) - (plist-get (cl--slot-descriptor-props slot) - :documentation)))) + (let ((doc (alist-get :documentation + (cl--slot-descriptor-props slot)))) (if (not doc) "" (setq has-doc t) (substitute-command-keys doc))))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 7365e23186..ef60b266f9 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -124,12 +124,11 @@ supertypes from the most specific to least specific.") (get name 'cl-struct-print)) (cl--find-class name))))) -(defun cl--plist-remove (plist member) - (cond - ((null plist) nil) - ((null member) plist) - ((eq plist member) (cddr plist)) - (t `(,(car plist) ,(cadr plist) ,@(cl--plist-remove (cddr plist) member))))) +(defun cl--plist-to-alist (plist) + (let ((res '())) + (while plist + (push (cons (pop plist) (pop plist)) res)) + (nreverse res))) (defun cl--struct-register-child (parent tag) ;; Can't use (cl-typep parent 'cl-structure-class) at this stage @@ -164,12 +163,14 @@ supertypes from the most specific to least specific.") (i 0) (offset (if type 0 1))) (dolist (slot slots) - (let* ((props (cddr slot)) - (typep (plist-member props :type)) - (type (if typep (cadr typep) t))) + (let* ((props (cl--plist-to-alist (cddr slot))) + (typep (assq :type props)) + (type (if (null typep) t + (setq props (delq typep props)) + (cdr typep)))) (aset v i (cl--make-slot-desc (car slot) (nth 1 slot) - type (cl--plist-remove props typep)))) + type props))) (puthash (car slot) (+ i offset) index-table) (cl-incf i)) v)) commit 6122e4c1f07a59196832f95a64a45517e7c5cce8 Author: Alex McGrath Date: Thu Jun 24 18:45:08 2021 +0200 Add SASL authentication to rcirc * lisp/net/rcirc.el (rcirc-handler-AUTHENTICATE): New function (bug#48601). (rcirc-authenticate): (rcirc-connect): Support sasl. (rcirc-get-server-password, rcirc-get-server-method): New functions. (rcirc-authinfo): Document it. diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index ff8133b2a1..e187bbbfe5 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -590,6 +590,12 @@ Use this symbol if you need to identify yourself in the Bitlbee channel as follows: @code{identify secret}. The necessary arguments are the nickname you want to use this for, and the password to use. +@item sasl +@cindex sasl authentication +Use this symbol if you want to use @acronym{SASL} authentication. The +necessary arguments are the nickname you want to use this for, and the +password to use. + @cindex gateway to other IM services @cindex instant messaging, other services @cindex Jabber diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 6c27acfadf..37c31be58f 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -261,13 +261,15 @@ The ARGUMENTS for each METHOD symbol are: `chanserv': NICK CHANNEL PASSWORD `bitlbee': NICK PASSWORD `quakenet': ACCOUNT PASSWORD + `sasl': NICK PASSWORD Examples: ((\"freenode\" nickserv \"bob\" \"p455w0rd\") (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\") (\"bitlbee\" bitlbee \"robert\" \"sekrit\") (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\") - (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))" + (\"quakenet.org\" quakenet \"bobby\" \"sekrit\") + (\"oftc\" sasl \"bob\" \"hunter2\"))" :type '(alist :key-type (regexp :tag "Server") :value-type (choice (list :tag "NickServ" (const nickserv) @@ -285,6 +287,10 @@ Examples: (list :tag "QuakeNet" (const quakenet) (string :tag "Account") + (string :tag "Password")) + (list :tag "SASL" + (const sasl) + (string :tag "Nick") (string :tag "Password"))))) (defcustom rcirc-auto-authenticate-flag t @@ -597,6 +603,7 @@ See `rcirc-connect' for more details on these variables.") "batch" ;https://ircv3.net/specs/extensions/batch "message-ids" ;https://ircv3.net/specs/extensions/message-ids "invite-notify" ;https://ircv3.net/specs/extensions/invite-notify + "sasl" ;https://ircv3.net/specs/extensions/sasl-3.1 ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -604,6 +611,24 @@ See `rcirc-connect' for more details on these variables.") (defvar-local rcirc-acked-capabilities nil "A list of capabilities that the server supports.") +(defun rcirc-get-server-method (server) + "Return authentication method for SERVER." + (catch 'method + (dolist (i rcirc-authinfo) + (let ((server-i (car i)) + (method (cadr i))) + (when (string-match server-i server) + (throw 'method method)))))) + +(defun rcirc-get-server-password (server) + "Return password for SERVER." + (catch 'pass + (dolist (i rcirc-authinfo) + (let ((server-i (car i)) + (args (cdddr i))) + (when (string-match server-i server) + (throw 'pass (car args))))))) + ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption @@ -3317,7 +3342,8 @@ Passwords are stored in `rcirc-authinfo' (which see)." (rcirc-send-privmsg process "&bitlbee" - (concat "IDENTIFY " (car args))))) + (concat "IDENTIFY " (car args)))) + (sasl nil)) ;; quakenet authentication doesn't rely on the user's nickname. ;; the variable `nick' here represents the Q account name. (when (eq method 'quakenet) @@ -3394,6 +3420,7 @@ PROCESS is the process object for the current connection." PROCESS is the process object for the current connection." (rcirc-print process sender "CTCP" nil message t)) + (defun rcirc-handler-CAP (process _sender args _text) "Handle capability negotiation messages. ARGS should have the form (USER SUBCOMMAND . ARGUMENTS). PROCESS @@ -3464,6 +3491,17 @@ object for the current connection." (delq (assoc id rcirc-batched-messages) rcirc-batched-messages))))))) +(defun rcirc-handler-AUTHENTICATE (process _cmd _args _text) + "Respond to authentication request. +PROCESS is the process object for the current connection." + (rcirc-send-string + process + "AUTHENTICATE" + (base64-encode-string + ;; use connection user-name + (concat "\0" (nth 3 rcirc-connection-info) + "\0" (rcirc-get-server-password rcirc-server))))) + (defgroup rcirc-faces nil "Faces for rcirc." commit 1283e1db9b7750a90472e7d557fdd75fcaff6446 Author: Mattias Engdegård Date: Thu Jun 24 20:48:41 2021 +0200 Don't call ERT explainer on error * lisp/emacs-lisp/ert.el (ert--expand-should-1): If the predicate form signals an error, don't call an explainer because the arguments passed (the error and error argument, respectively) do not make any sense to the explainer at all. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 6793b374ee..7de07bd6f5 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -313,12 +313,13 @@ It should only be stopped when ran from inside ert--run-test-internal." (list :form `(,,fn ,@,args)) (unless (eql ,value ',default-value) (list :value ,value)) - (let ((-explainer- - (and (symbolp ',fn-name) - (get ',fn-name 'ert-explainer)))) - (when -explainer- - (list :explanation - (apply -explainer- ,args))))) + (unless (eql ,value ',default-value) + (let ((-explainer- + (and (symbolp ',fn-name) + (get ',fn-name 'ert-explainer)))) + (when -explainer- + (list :explanation + (apply -explainer- ,args)))))) value) ,value)))))))) commit b188861af403aa0da0fefc3a8bf73c9380297e4e Author: Lars Ingebrigtsen Date: Thu Jun 24 20:24:43 2021 +0200 Attempt to make defclass documentation more legible * lisp/emacs-lisp/cl-extra.el (cl--print-table): Attempt to make defclass documentation more readable (bug#30998). (cl--describe-class-slots): Ditto. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 1303654482..c30349de6b 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -847,7 +847,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. "\n"))) "\n")) -(defun cl--print-table (header rows) +(defun cl--print-table (header rows &optional last-slot-on-next-line) ;; FIXME: Isn't this functionality already implemented elsewhere? (let ((cols (apply #'vector (mapcar #'string-width header))) (col-space 2)) @@ -877,7 +877,11 @@ PROPLIST is a list of the sort returned by `symbol-plist'. header)) "\n") (dolist (row rows) - (insert (apply #'format format row) "\n")))))) + (insert (apply #'format format row) "\n") + (when last-slot-on-next-line + (dolist (line (string-lines (car (last row)))) + (insert " " line "\n")) + (insert "\n"))))))) (defun cl--describe-class-slots (class) "Print help description for the slots in CLASS. @@ -909,8 +913,7 @@ Outputs to the current buffer." (setq has-doc t) (substitute-command-keys doc))))) slots))) - (cl--print-table `("Name" "Type" "Default" . ,(if has-doc '("Doc"))) - slots-strings)) + (cl--print-table `("Name" "Type" "Default") slots-strings has-doc)) (insert "\n") (when (> (length cslots) 0) (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold)) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 1c13c398dd..468d124c0e 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -317,6 +317,7 @@ than this function." (end (substring string (- (length string) length))) (t (substring string 0 length))))) +;;;###autoload (defun string-lines (string &optional omit-nulls) "Split STRING into a list of lines. If OMIT-NULLS, empty lines will be removed from the results." commit bf21aba533864bf0179b2e76f4bdc2e7c6cce726 Author: Lars Ingebrigtsen Date: Thu Jun 24 20:13:08 2021 +0200 Fix printing of defclass documentation slots again * lisp/emacs-lisp/cl-extra.el (cl--describe-class-slots): Fix printing defclass slots, and retain printing of defstruct slots (bug#30998 and bug#46662). diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index eabba27d22..1303654482 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -897,8 +897,14 @@ Outputs to the current buffer." (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) (cl-prin1-to-string (cl--slot-descriptor-type slot)) (cl-prin1-to-string (cl--slot-descriptor-initform slot)) - (let ((doc (plist-get (cl--slot-descriptor-props slot) - :documentation))) + (let ((doc + ;; The props are an alist in a `defclass', + ;; but a plist when describing a `cl-defstruct'. + (if (consp (car (cl--slot-descriptor-props slot))) + (alist-get :documentation + (cl--slot-descriptor-props slot)) + (plist-get (cl--slot-descriptor-props slot) + :documentation)))) (if (not doc) "" (setq has-doc t) (substitute-command-keys doc))))) commit 8e6d6daacf3994a68f81b92ae2ce47ccf2a7bf28 Author: Lars Ingebrigtsen Date: Thu Jun 24 18:51:38 2021 +0200 Allow `C-u M-x dig' to ask for a query type * lisp/net/dig.el (dig): Allow prompting for a query type (bug#31810). diff --git a/etc/NEWS b/etc/NEWS index 10f260a515..0001758b14 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2134,6 +2134,9 @@ summaries will include the failing condition. ** Miscellaneous +--- +*** `C-x M-x dig' will now prompt for a query type to use. + +++ *** rcirc now supports SASL authentication. diff --git a/lisp/net/dig.el b/lisp/net/dig.el index ddbfb9598b..4f0b0df2b7 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -138,9 +138,14 @@ Buffer should contain output generated by `dig-invoke'." ;;;###autoload (defun dig (domain &optional query-type query-class query-option dig-option server) - "Query addresses of a DOMAIN using dig, by calling `dig-invoke'. -Optional arguments are passed to `dig-invoke'." - (interactive "sHost: ") + "Query addresses of a DOMAIN using dig. +See `dig-invoke' for an explanation for the parameters. +When called interactively, DOMAIN is prompted for. If given a prefix, +also prompt for the QUERY-TYPE parameter." + (interactive + (list (read-string "Host: ") + (and current-prefix-arg + (read-string "Query type: ")))) (pop-to-buffer-same-window (dig-invoke domain query-type query-class query-option dig-option server)) (goto-char (point-min)) commit 8db520837a796394a8fe713fda29d92578085096 Author: Alex McGrath Date: Thu Jun 24 18:45:08 2021 +0200 Add SASL authentication to rcirc * lisp/net/rcirc.el (rcirc-handler-AUTHENTICATE): New function (bug#48601). (rcirc-authenticate): (rcirc-connect): Support sasl. (rcirc-get-server-password, rcirc-get-server-method): New functions. (rcirc-authinfo): Document it. diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index ff8133b2a1..e187bbbfe5 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -590,6 +590,12 @@ Use this symbol if you need to identify yourself in the Bitlbee channel as follows: @code{identify secret}. The necessary arguments are the nickname you want to use this for, and the password to use. +@item sasl +@cindex sasl authentication +Use this symbol if you want to use @acronym{SASL} authentication. The +necessary arguments are the nickname you want to use this for, and the +password to use. + @cindex gateway to other IM services @cindex instant messaging, other services @cindex Jabber diff --git a/etc/NEWS b/etc/NEWS index 0631eaf822..10f260a515 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2134,6 +2134,9 @@ summaries will include the failing condition. ** Miscellaneous ++++ +*** rcirc now supports SASL authentication. + +++ *** 'save-interprogram-paste-before-kill' can now be a number. In that case, it's interpreted as a limit on the size of the clipboard diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4fdb63e2eb..edbbc1eb9f 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -245,13 +245,15 @@ The ARGUMENTS for each METHOD symbol are: `chanserv': NICK CHANNEL PASSWORD `bitlbee': NICK PASSWORD `quakenet': ACCOUNT PASSWORD + `sasl': NICK PASSWORD Examples: ((\"freenode\" nickserv \"bob\" \"p455w0rd\") (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\") (\"bitlbee\" bitlbee \"robert\" \"sekrit\") (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\") - (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))" + (\"quakenet.org\" quakenet \"bobby\" \"sekrit\") + (\"oftc\" sasl \"bob\" \"hunter2\"))" :type '(alist :key-type (regexp :tag "Server") :value-type (choice (list :tag "NickServ" (const nickserv) @@ -269,6 +271,10 @@ Examples: (list :tag "QuakeNet" (const quakenet) (string :tag "Account") + (string :tag "Password")) + (list :tag "SASL" + (const sasl) + (string :tag "Nick") (string :tag "Password"))))) (defcustom rcirc-auto-authenticate-flag t @@ -543,6 +549,22 @@ If ARG is non-nil, instead prompt for connection parameters." (defvar rcirc-connection-info nil) (defvar rcirc-process nil) +(defun rcirc-get-server-method (server) + (catch 'method + (dolist (i rcirc-authinfo) + (let ((server-i (car i)) + (method (cadr i))) + (when (string-match server-i server) + (throw 'method method)))))) + +(defun rcirc-get-server-password (server) + (catch 'pass + (dolist (i rcirc-authinfo) + (let ((server-i (car i)) + (args (cdddr i))) + (when (string-match server-i server) + (throw 'pass (car args))))))) + ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption @@ -559,6 +581,7 @@ If ARG is non-nil, instead prompt for connection parameters." (user-name (or user-name rcirc-default-user-name)) (full-name (or full-name rcirc-default-full-name)) (startup-channels startup-channels) + (use-sasl (eq (rcirc-get-server-method server) 'sasl)) (process (open-network-stream (or server-alias server) nil server port-number :type (or encryption 'plain)))) @@ -591,6 +614,8 @@ If ARG is non-nil, instead prompt for connection parameters." (setq-local rcirc-server-parameters nil) (add-hook 'auto-save-hook 'rcirc-log-write) + (when use-sasl + (rcirc-send-string process "CAP REQ sasl")) ;; identify (unless (zerop (length password)) @@ -598,6 +623,10 @@ If ARG is non-nil, instead prompt for connection parameters." (rcirc-send-string process (concat "NICK " nick)) (rcirc-send-string process (concat "USER " user-name " 0 * :" full-name)) + ;; Setup sasl, and initiate authentication. + (when (and rcirc-auto-authenticate-flag + use-sasl) + (rcirc-send-string process "AUTHENTICATE PLAIN")) ;; setup ping timer if necessary (unless rcirc-keepalive-timer @@ -2923,7 +2952,8 @@ Passwords are stored in `rcirc-authinfo' (which see)." (rcirc-send-privmsg process "&bitlbee" - (concat "IDENTIFY " (car args))))) + (concat "IDENTIFY " (car args)))) + (sasl nil)) ;; quakenet authentication doesn't rely on the user's nickname. ;; the variable `nick' here represents the Q account name. (when (eq method 'quakenet) @@ -2969,6 +2999,16 @@ Passwords are stored in `rcirc-authinfo' (which see)." (defun rcirc-handler-CTCP-response (process _target sender message) (rcirc-print process sender "CTCP" nil message t)) + +(defun rcirc-handler-AUTHENTICATE (process _cmd _args _text) + (rcirc-send-string + process + (format "AUTHENTICATE %s" + (base64-encode-string + ;; use connection user-name + (concat "\0" (nth 3 rcirc-connection-info) + "\0" (rcirc-get-server-password rcirc-server)))))) + (defgroup rcirc-faces nil "Faces for rcirc." commit 8febca87c34b4d5810fc45ecba96a8260a4cc06d Author: E. Choroba Date: Thu Jun 24 18:15:07 2021 +0200 Fix highlighting in cperl-mode for "for /regex/" * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Fix highlighting of regexp in "print for /./;" (bug#49192). diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index fa384bcad6..3370df6491 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3981,7 +3981,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (not (memq (preceding-char) '(?$ ?@ ?& ?%))) (looking-at - "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))) + "\\(while\\|if\\|unless\\|until\\|for\\(each\\)?\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))) (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) commit ed30a7290cbca58c21560e8251738665118d98ef Author: Jim Porter Date: Thu Jun 24 18:07:25 2021 +0200 Ignore file-missing errors during diff-refined font-locking * lisp/vc/diff-mode.el (diff--font-lock-refined): Ignore file-missing errors (bug#49197). diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index a0093391c6..4652afa1f9 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2265,17 +2265,20 @@ Call FUN with two args (BEG and END) for each hunk." ;; same hunk. (goto-char (next-single-char-property-change (point) 'diff--font-lock-refined nil max))) - (diff--iterate-hunks - max - (lambda (beg end) - (unless (get-char-property beg 'diff--font-lock-refined) - (diff--refine-hunk beg end) - (let ((ol (make-overlay beg end))) - (overlay-put ol 'diff--font-lock-refined t) - (overlay-put ol 'diff-mode 'fine) - (overlay-put ol 'evaporate t) - (overlay-put ol 'modification-hooks - '(diff--overlay-auto-delete)))))))) + ;; Ignore errors that diff cannot be found so that custom font-lock + ;; keywords after `diff--font-lock-refined' can still be evaluated. + (ignore-error file-missing + (diff--iterate-hunks + max + (lambda (beg end) + (unless (get-char-property beg 'diff--font-lock-refined) + (diff--refine-hunk beg end) + (let ((ol (make-overlay beg end))) + (overlay-put ol 'diff--font-lock-refined t) + (overlay-put ol 'diff-mode 'fine) + (overlay-put ol 'evaporate t) + (overlay-put ol 'modification-hooks + '(diff--overlay-auto-delete))))))))) (defun diff--overlay-auto-delete (ol _after _beg _end &optional _len) (delete-overlay ol)) commit f85ee6d5c7ec23ee94573753275f9089215be7fd Author: Lars Ingebrigtsen Date: Thu Jun 24 16:59:42 2021 +0200 Clarify the help in the package buffers * lisp/emacs-lisp/package.el (package--quick-help-keys): Clarify marking help (bug#40457). diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5df9b53657..a0f1ab0ed6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3374,7 +3374,8 @@ If optional arg BUTTON is non-nil, describe its associated package." (forward-line 1))))) (defvar package--quick-help-keys - '(("install," "delete," "unmark," ("execute" . 1)) + '((("mark for installation," . 9) + ("mark for deletion," . 9) "unmark," ("execute marked actions" . 1)) ("next," "previous") ("Hide-package," "(-toggle-hidden") ("g-refresh-contents," "/-filter," "help"))) commit 3665735d664208f1b198ac20ee82639fc151db69 Author: Jim Porter Date: Thu Jun 24 16:50:51 2021 +0200 Sort the items in 'mode-line-mode-menu' before displaying the menu * lisp/bindings.el (bindings--menu-item-string, bindings--sort-keymap): New functions. (mode-line-major-mode-keymap, mode-line-minor-mode-keymap): Sort 'mode-line-mode-menu'. diff --git a/lisp/bindings.el b/lisp/bindings.el index 620f28970a..d63783a45d 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -330,22 +330,57 @@ of the menu's data." (defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\ Menu of mode operations in the mode line.") +(defun bindings--menu-item-string (item) + "Return the menu-item string for ITEM, or nil if not a menu-item." + (cond + ((not (consp item)) nil) ; Not a menu-item. + ((eq 'menu-item (car item)) + (eval (cadr item))) + ((stringp (car item)) + (car item)) + (t nil))) ; Not a menu-item either. + +(defun bindings--sort-keymap (map) + "Sort the bindings in MAP in alphabetical order by menu-item string. +The order of bindings in a keymap matters only when it is used as +a menu, so this function is not useful for non-menu keymaps." + (let ((bindings nil) + (prompt (keymap-prompt map))) + (while (keymapp map) + (setq map (map-keymap + (lambda (key item) + ;; FIXME: Handle char-ranges here? + (push (cons key item) bindings)) + map))) + ;; Sort the bindings and make a new keymap from them. + (setq bindings + (sort bindings + (lambda (a b) + (string< (bindings--menu-item-string (cdr-safe a)) + (bindings--menu-item-string (cdr-safe b)))))) + (nconc (make-sparse-keymap prompt) bindings))) + (defvar mode-line-major-mode-keymap (let ((map (make-sparse-keymap))) (bindings--define-key map [mode-line down-mouse-1] `(menu-item "Menu Bar" ignore :filter ,(lambda (_) (mouse-menu-major-mode-map)))) (define-key map [mode-line mouse-2] 'describe-mode) - (define-key map [mode-line down-mouse-3] mode-line-mode-menu) + (bindings--define-key map [mode-line down-mouse-3] + `(menu-item "Menu Bar" ,mode-line-mode-menu + :filter bindings--sort-keymap)) map) "\ Keymap to display on major mode.") (defvar mode-line-minor-mode-keymap - (let ((map (make-sparse-keymap))) + (let ((map (make-sparse-keymap)) + (mode-menu-binding + `(menu-item "Menu Bar" ,mode-line-mode-menu + :filter bindings--sort-keymap))) (define-key map [mode-line down-mouse-1] 'mouse-minor-mode-menu) (define-key map [mode-line mouse-2] 'mode-line-minor-mode-help) - (define-key map [mode-line down-mouse-3] mode-line-mode-menu) - (define-key map [header-line down-mouse-3] mode-line-mode-menu) + (define-key map [mode-line down-mouse-3] mode-menu-binding) + (define-key map [header-line down-mouse-3] mode-menu-binding) map) "\ Keymap to display on minor modes.") commit 7be75f17e79b547dc03e26e3980d4ce75bfa668d Author: Saroj Thirumalai Date: Wed Jun 23 23:17:03 2021 +0300 * lisp/printing.el (pr-global-menubar): Fix duplicate menu problem. In Emacs 27.1 Print menu items were moved to a submenu of the File menu. The Printing package (lisp/printing.el) replaces the Print menu (via the function: pr-global-menubar). The latter needs to be updated to reflect the changes; otherwise, a second Print (sub)menu is created at the end of the File menu. Copyright-paperwork-exempt: yes diff --git a/lisp/printing.el b/lisp/printing.el index 5c7da96551..e7aab901d5 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1081,24 +1081,15 @@ Used by `pr-menu-bind' and `pr-update-menus'.") "Specify Printing menu-bar entry.") (defun pr-global-menubar (menu-spec) - (let ((menu-file '("menu-bar" "file"))) - (cond - (pr-menu-print-item - (easy-menu-add-item global-map menu-file - (easy-menu-create-menu "Print" menu-spec) - "print-buffer") - (dolist (item '("print-buffer" "print-region" - "ps-print-buffer-faces" "ps-print-region-faces" - "ps-print-buffer" "ps-print-region")) - (easy-menu-remove-item global-map menu-file item)) - (setq pr-menu-print-item nil - pr-menu-bar (vector 'menu-bar - (easy-menu-intern (nth 1 menu-file)) - (easy-menu-intern "Print")))) - (t - (easy-menu-add-item global-map menu-file - (easy-menu-create-menu "Print" menu-spec))) - ))) + (let ((menu-file '("menu-bar" "file")) + (submenu-path [menu-bar file Print]) + (submenu (easy-menu-create-menu "Print" menu-spec))) + (cond (pr-menu-print-item + (easy-menu-add-item global-map menu-file submenu "Print") + (easy-menu-remove-item global-map menu-file "print") + (setq pr-menu-print-item nil + pr-menu-bar submenu-path)) + (t (easy-menu-add-item global-map menu-file submenu))))) (defun pr-menu-position (entry index horizontal) (let ((pos (cdr (mouse-pixel-position)))) commit 006628df1823ef10bed92c71bee490717f2c2864 Author: Mauro Aranda Date: Wed Jun 23 12:08:04 2021 -0300 Fix defvar->defcustom conversion in ethio-util.el * lisp/language/ethio-util.el (ethio-primary-language) (ethio-secondary-language): Don't quote the const. (ethio-use-three-dot-question, ethio-quote-vowel-always) (ethio-W-sixth-always, ethio-numeric-reduction) (ethio-java-save-lowercase): Really make them defcustom. diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index 1d698229d6..dc385b07d3 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el @@ -107,17 +107,17 @@ "Symbol that defines the primary language in SERA --> FIDEL conversion. The value should be one of: `tigrigna', `amharic' or `english'." :version "28.1" - :type '(choice (const :tag "Tigrigna" 'tigrigna) - (const :tag "Amharic" 'amharic) - (const :tag "English" 'english))) + :type '(choice (const :tag "Tigrigna" tigrigna) + (const :tag "Amharic" amharic) + (const :tag "English" english))) (defcustom ethio-secondary-language 'english "Symbol that defines the secondary language in SERA --> FIDEL conversion. The value should be one of: `tigrigna', `amharic' or `english'." :version "28.1" - :type '(choice (const :tag "Tigrigna" 'tigrigna) - (const :tag "Amharic" 'amharic) - (const :tag "English" 'english))) + :type '(choice (const :tag "Tigrigna" tigrigna) + (const :tag "Amharic" amharic) + (const :tag "English" english))) (defcustom ethio-use-colon-for-colon nil "Non-nil means associate ASCII colon with Ethiopic colon. @@ -127,7 +127,7 @@ variable." :version "28.1" :type 'boolean) -(defvar ethio-use-three-dot-question nil +(defcustom ethio-use-three-dot-question nil "If non-nil, associate ASCII question mark with Ethiopic question mark. The Ethiopic old style question mark is three vertically stacked dots. If nil, associate ASCII question mark with Ethiopic stylized question @@ -135,7 +135,7 @@ mark. All SERA <--> FIDEL converters refer this variable." :version "28.1" :type 'boolean) -(defvar ethio-quote-vowel-always nil +(defcustom ethio-quote-vowel-always nil "Non-nil means always put an apostrophe before an isolated vowel. This happens in FIDEL --> SERA conversions. Isolated vowels at word beginning do not get an apostrophe put before them. @@ -144,13 +144,13 @@ isolated vowel." :version "28.1" :type 'boolean) -(defvar ethio-W-sixth-always nil +(defcustom ethio-W-sixth-always nil "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\". This is instead of \"Wu\" in FIDEL --> SERA conversion." :version "28.1" :type 'boolean) -(defvar ethio-numeric-reduction 0 +(defcustom ethio-numeric-reduction 0 "Degree of reduction in converting Ethiopic digits into Arabic digits. Should be 0, 1 or 2. For example, ({10}{9}{100}{80}{7}) is converted into: @@ -160,7 +160,7 @@ For example, ({10}{9}{100}{80}{7}) is converted into: :version "28.1" :type 'integer) -(defvar ethio-java-save-lowercase nil +(defcustom ethio-java-save-lowercase nil "Non-nil means save Ethiopic characters in lowercase hex numbers to Java files. If nil, use uppercases." :version "28.1" commit 0776ac06803100e36d2ff7532744186f70bfcb56 Author: Lars Ingebrigtsen Date: Wed Jun 23 16:28:32 2021 +0200 Make ethio-* variables into user options * lisp/language/ethio-util.el (ethiopic): New group. (ethio-primary-language, ethio-secondary-language) (ethio-use-colon-for-colon, ethio-use-three-dot-question) (ethio-quote-vowel-always, ethio-W-sixth-always) (ethio-numeric-reduction, ethio-java-save-lowercase): Make into user options (bug#33024). diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index fa31cd5f9f..1d698229d6 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el @@ -98,36 +98,57 @@ ;; users' preference ;; -(defvar ethio-primary-language 'tigrigna +(defgroup ethiopic nil + "Options for writing Ethiopic." + :version "28.1" + :group 'languages) + +(defcustom ethio-primary-language 'tigrigna "Symbol that defines the primary language in SERA --> FIDEL conversion. -The value should be one of: `tigrigna', `amharic' or `english'.") +The value should be one of: `tigrigna', `amharic' or `english'." + :version "28.1" + :type '(choice (const :tag "Tigrigna" 'tigrigna) + (const :tag "Amharic" 'amharic) + (const :tag "English" 'english))) -(defvar ethio-secondary-language 'english +(defcustom ethio-secondary-language 'english "Symbol that defines the secondary language in SERA --> FIDEL conversion. -The value should be one of: `tigrigna', `amharic' or `english'.") +The value should be one of: `tigrigna', `amharic' or `english'." + :version "28.1" + :type '(choice (const :tag "Tigrigna" 'tigrigna) + (const :tag "Amharic" 'amharic) + (const :tag "English" 'english))) -(defvar ethio-use-colon-for-colon nil +(defcustom ethio-use-colon-for-colon nil "Non-nil means associate ASCII colon with Ethiopic colon. If nil, associate ASCII colon with Ethiopic word separator, i.e., two vertically stacked dots. All SERA <--> FIDEL converters refer this -variable.") +variable." + :version "28.1" + :type 'boolean) (defvar ethio-use-three-dot-question nil "If non-nil, associate ASCII question mark with Ethiopic question mark. The Ethiopic old style question mark is three vertically stacked dots. If nil, associate ASCII question mark with Ethiopic stylized question -mark. All SERA <--> FIDEL converters refer this variable.") +mark. All SERA <--> FIDEL converters refer this variable." + :version "28.1" + :type 'boolean) (defvar ethio-quote-vowel-always nil "Non-nil means always put an apostrophe before an isolated vowel. This happens in FIDEL --> SERA conversions. Isolated vowels at word beginning do not get an apostrophe put before them. If nil, put an apostrophe only between a 6th-form consonant and an -isolated vowel.") +isolated vowel." + :version "28.1" + :type 'boolean) (defvar ethio-W-sixth-always nil "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\". -This is instead of \"Wu\" in FIDEL --> SERA conversion.") +This is instead of \"Wu\" in FIDEL --> SERA conversion." + :version "28.1" + :type 'boolean) (defvar ethio-numeric-reduction 0 "Degree of reduction in converting Ethiopic digits into Arabic digits. @@ -135,11 +156,16 @@ Should be 0, 1 or 2. For example, ({10}{9}{100}{80}{7}) is converted into: \\=`10\\=`9\\=`100\\=`80\\=`7 if `ethio-numeric-reduction' is 0, \\=`109100807 if `ethio-numeric-reduction' is 1, - \\=`10900807 if `ethio-numeric-reduction' is 2.") + \\=`10900807 if `ethio-numeric-reduction' is 2." + :version "28.1" + :type 'integer) (defvar ethio-java-save-lowercase nil "Non-nil means save Ethiopic characters in lowercase hex numbers to Java files. -If nil, use uppercases.") +If nil, use uppercases." + :version "28.1" + :type 'boolean) + (defun ethio-prefer-amharic-p () (or (eq ethio-primary-language 'amharic) commit 4b90e4f44f9c8698da66c41141ad5693aadc86a1 Author: Lars Ingebrigtsen Date: Wed Jun 23 16:10:25 2021 +0200 Revert "Sort the items in 'mode-line-mode-menu' before displaying the menu" This reverts commit d4d6d8f335165e2bda8942b4acd45e5bab613b70. This approach doesn't work on certain types of keymaps, so it should be implemented in a different way. diff --git a/lisp/bindings.el b/lisp/bindings.el index 8d902ba3df..620f28970a 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -330,50 +330,22 @@ of the menu's data." (defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\ Menu of mode operations in the mode line.") -(defun bindings--menu-item-string (item) - "Return the menu-item string for ITEM, or nil if not a menu-item." - (cond - ((not (consp item)) nil) ; Not a menu-item. - ((eq 'menu-item (car item)) - (eval (cadr item))) - ((stringp (car item)) - (car item)) - (t nil))) ; Not a menu-item either. - -(defun bindings--sort-keymap (keymap) - "Sort the bindings in KEYMAP in alphabetical order. -The order of bindings in a keymap matters only when it is used as -a menu, so this function is not useful for non-menu keymaps." - (unless (keymapp keymap) - (signal 'wrong-type-argument (list 'keymapp keymap))) - (setcdr keymap - (sort (cdr keymap) - (lambda (a b) - (string< (bindings--menu-item-string (cdr-safe a)) - (bindings--menu-item-string (cdr-safe b)))))) - keymap) - (defvar mode-line-major-mode-keymap (let ((map (make-sparse-keymap))) (bindings--define-key map [mode-line down-mouse-1] `(menu-item "Menu Bar" ignore :filter ,(lambda (_) (mouse-menu-major-mode-map)))) (define-key map [mode-line mouse-2] 'describe-mode) - (bindings--define-key map [mode-line down-mouse-3] - `(menu-item "Menu Bar" ,mode-line-mode-menu - :filter bindings--sort-keymap)) + (define-key map [mode-line down-mouse-3] mode-line-mode-menu) map) "\ Keymap to display on major mode.") (defvar mode-line-minor-mode-keymap - (let ((map (make-sparse-keymap)) - (mode-menu-binding - `(menu-item "Menu Bar" ,mode-line-mode-menu - :filter bindings--sort-keymap))) + (let ((map (make-sparse-keymap))) (define-key map [mode-line down-mouse-1] 'mouse-minor-mode-menu) (define-key map [mode-line mouse-2] 'mode-line-minor-mode-help) - (define-key map [mode-line down-mouse-3] mode-menu-binding) - (define-key map [header-line down-mouse-3] mode-menu-binding) + (define-key map [mode-line down-mouse-3] mode-line-mode-menu) + (define-key map [header-line down-mouse-3] mode-line-mode-menu) map) "\ Keymap to display on minor modes.") commit d4d6d8f335165e2bda8942b4acd45e5bab613b70 Author: Jim Porter Date: Wed Jun 23 15:02:52 2021 +0200 Sort the items in 'mode-line-mode-menu' before displaying the menu * lisp/bindings.el (bindings--menu-item-string, bindings--sort-keymap): New functions. (mode-line-major-mode-keymap, mode-line-minor-mode-keymap): Sort 'mode-line-mode-menu'. diff --git a/lisp/bindings.el b/lisp/bindings.el index 620f28970a..8d902ba3df 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -330,22 +330,50 @@ of the menu's data." (defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\ Menu of mode operations in the mode line.") +(defun bindings--menu-item-string (item) + "Return the menu-item string for ITEM, or nil if not a menu-item." + (cond + ((not (consp item)) nil) ; Not a menu-item. + ((eq 'menu-item (car item)) + (eval (cadr item))) + ((stringp (car item)) + (car item)) + (t nil))) ; Not a menu-item either. + +(defun bindings--sort-keymap (keymap) + "Sort the bindings in KEYMAP in alphabetical order. +The order of bindings in a keymap matters only when it is used as +a menu, so this function is not useful for non-menu keymaps." + (unless (keymapp keymap) + (signal 'wrong-type-argument (list 'keymapp keymap))) + (setcdr keymap + (sort (cdr keymap) + (lambda (a b) + (string< (bindings--menu-item-string (cdr-safe a)) + (bindings--menu-item-string (cdr-safe b)))))) + keymap) + (defvar mode-line-major-mode-keymap (let ((map (make-sparse-keymap))) (bindings--define-key map [mode-line down-mouse-1] `(menu-item "Menu Bar" ignore :filter ,(lambda (_) (mouse-menu-major-mode-map)))) (define-key map [mode-line mouse-2] 'describe-mode) - (define-key map [mode-line down-mouse-3] mode-line-mode-menu) + (bindings--define-key map [mode-line down-mouse-3] + `(menu-item "Menu Bar" ,mode-line-mode-menu + :filter bindings--sort-keymap)) map) "\ Keymap to display on major mode.") (defvar mode-line-minor-mode-keymap - (let ((map (make-sparse-keymap))) + (let ((map (make-sparse-keymap)) + (mode-menu-binding + `(menu-item "Menu Bar" ,mode-line-mode-menu + :filter bindings--sort-keymap))) (define-key map [mode-line down-mouse-1] 'mouse-minor-mode-menu) (define-key map [mode-line mouse-2] 'mode-line-minor-mode-help) - (define-key map [mode-line down-mouse-3] mode-line-mode-menu) - (define-key map [header-line down-mouse-3] mode-line-mode-menu) + (define-key map [mode-line down-mouse-3] mode-menu-binding) + (define-key map [header-line down-mouse-3] mode-menu-binding) map) "\ Keymap to display on minor modes.") commit d87b67a9e24ecc6c777fad0e3e6b71a7b68ab0df Author: dickmao Date: Wed Jun 23 14:50:05 2021 +0200 Clean up code in `message-replace-header' * lisp/gnus/message.el (message-replace-header): Elide redundancy (bug#49180). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 69e2c5cbbc..a9be2d6b34 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8730,12 +8730,10 @@ headers. If FORCE, insert new field even if NEW-VALUE is empty." (message-narrow-to-headers) (message-remove-header header)) (when (or force (> (length new-value) 0)) - (if after - (apply #'message-position-on-field header - (if (listp after) - after - (list after))) - (message-position-on-field header)) + (apply #'message-position-on-field header + (if (listp after) + after + (list after))) (insert new-value)))) (make-obsolete-variable commit b81c97779909275b8b9d36c00d789dceba6f28e5 Author: Philip Kaludercic Date: Mon Jun 21 09:12:25 2021 +0200 Query encryption using yes-or-no-p * rcirc.el (rcirc-prompt-for-encryption): Replace completing-read prompt with yes-or-no-p diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 9e14d1b12a..6c27acfadf 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -691,12 +691,9 @@ that are joined after authentication." (defun rcirc-prompt-for-encryption (server-plist) "Prompt the user for the encryption method to use. SERVER-PLIST is the property list for the server." - (let ((choices '("plain" "tls")) - (default (or (plist-get server-plist :encryption) - "plain"))) - (intern - (completing-read (format-prompt "Encryption" default) - choices nil t nil nil default)))) + (if (or (eq (plist-get server-plist :encryption) 'plain) + (yes-or-no-p "Encrypt connection?")) + 'tls 'plain)) (defun rcirc-keepalive () "Send keep alive pings to active rcirc processes. commit 869db473cbd510270faec2ba43dd4a5ba10b0020 Author: Philip Kaludercic Date: Sat Jun 19 10:43:26 2021 +0200 Use add-to-list instead of manually modifying minor-mode-alist diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 561589c458..9e14d1b12a 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2104,12 +2104,8 @@ This function does not alter the INPUT string." (remove-hook 'window-configuration-change-hook 'rcirc-window-configuration-change))) -(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist) - (setq minor-mode-alist - (cons '(rcirc-ignore-buffer-activity-flag " Ignore") minor-mode-alist))) -(or (assq 'rcirc-low-priority-flag minor-mode-alist) - (setq minor-mode-alist - (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist))) +(add-to-list 'minor-mode-alist '(rcirc-ignore-buffer-activity-flag " Ignore")) +(add-to-list 'minor-mode-alist '(rcirc-low-priority-flag " LowPri")) (defun rcirc-toggle-ignore-buffer-activity () "Toggle the value of `rcirc-ignore-buffer-activity-flag'." commit 21148f67f1f99581fe6fc96afd80f33ae3365ede Author: Philip Kaludercic Date: Wed Jun 16 09:43:05 2021 +0200 Force mode line update after modifying activity string * rcirc.el (rcirc-update-activity-string): Call force-mode-line-update diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index d4f0ccd47c..561589c458 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2245,7 +2245,8 @@ activity. Only run if the buffer is not visible and ((not (null (rcirc-process-list))) "[]") (t "[]"))) - (run-hooks 'rcirc-update-activity-string-hook))) + (run-hooks 'rcirc-update-activity-string-hook) + (force-mode-line-update t))) (defun rcirc-activity-string (buffers) "Generate activity string for all BUFFERS." commit b5d935bb7f5a37ddeba5bf9971d5aaec9a0698c2 Author: Philip Kaludercic Date: Tue Jun 15 23:44:56 2021 +0200 Fix edge case with single argument for rcirc-define-command * rcirc.el (rcirc-define-command): Update regular expression generator diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4d98d65d58..d4f0ccd47c 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2403,12 +2403,12 @@ that, an interactive form can specified." (insert "\\`") (when arguments (dotimes (_ (1- (length arguments))) - (insert "\\(?:\\(.+?\\)")) - (insert "\\(?:[[:space:]]+\\(.*\\)\\)") + (insert "\\(?:\\(.+?\\)[[:space:]]+")) (dotimes (i (1- (length arguments))) - (when (< i optional) - (insert "?")) - (insert "\\)"))) + (if (< i optional) + (insert "\\)?") + (insert "\\)")))) + (insert "\\(.*?\\)") (insert "[[:space:]]*\\'") (buffer-string))) (argument (gensym)) commit 7e5360f32203ad7536dafd000938abd621bd0a2e Author: Philip Kaludercic Date: Tue Jun 15 23:12:02 2021 +0200 Fix argument parser for rcirc-define-command with string input * rcirc.el (rcirc-define-command): Require at least one space between arguments diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index dfa80bb408..4d98d65d58 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2403,8 +2403,8 @@ that, an interactive form can specified." (insert "\\`") (when arguments (dotimes (_ (1- (length arguments))) - (insert "\\(?:\\(.+?\\)[[:space:]]*")) - (insert "\\(.*\\)") + (insert "\\(?:\\(.+?\\)")) + (insert "\\(?:[[:space:]]+\\(.*\\)\\)") (dotimes (i (1- (length arguments))) (when (< i optional) (insert "?")) commit 1181c606b3ff76488c068ce057cd7596e6c49cea Author: Philip Kaludercic Date: Tue Jun 15 18:16:58 2021 +0200 Check if server buffer is live * rcirc.el (with-rcirc-server-buffer): Use live-buffer-p (rcirc-buffer-nick): Use with-rcirc-server-buffer (rcirc-switch-to-server-buffer): Use with-rcirc-server-buffer diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 36a46dd208..dfa80bb408 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -681,8 +681,10 @@ that are joined after authentication." (defmacro with-rcirc-server-buffer (&rest body) "Evaluate BODY in the server buffer of the current channel." (declare (indent 0) (debug t)) - `(with-current-buffer rcirc-server-buffer - ,@body)) + `(if (buffer-live-p rcirc-server-buffer) + (with-current-buffer rcirc-server-buffer + ,@body) + (user-error "Server buffer was killed"))) (define-obsolete-function-alias 'rcirc-float-time 'float-time "26.1") @@ -1037,7 +1039,7 @@ With no argument or nil as argument, use the current buffer." "Return the nick associated with BUFFER. With no argument or nil as argument, use the current buffer." (with-current-buffer (or buffer (current-buffer)) - (with-current-buffer rcirc-server-buffer + (with-rcirc-server-buffer (or rcirc-nick rcirc-default-nick)))) (defvar rcirc-max-message-length 420 @@ -2132,9 +2134,7 @@ This function does not alter the INPUT string." (defun rcirc-switch-to-server-buffer () "Switch to the server buffer associated with current channel buffer." (interactive) - (unless (buffer-live-p rcirc-server-buffer) - (error "No such buffer")) - (switch-to-buffer rcirc-server-buffer)) + (switch-to-buffer (with-rcirc-server-buffer (current-buffer)))) (defun rcirc-jump-to-first-unread-line () "Move the point to the first unread line in this buffer." commit 946ceca26f55c33fdeb63759639c59c69e4af43e Author: Philip Kaludercic Date: Tue Jun 15 09:37:17 2021 +0200 Improve message markup * rcirc.el (rcirc-markup-text-functions): Add rcirc-color-attributes, rcirc-remove-markup-codes (rcirc-markup-attributes): Recognize strike-through and monospace, don't remove control codes (rcirc-color-attributes): Recognize mIRC color codes (rcirc-remove-markup-codes): Add function (rcirc-monospace-text): Add face diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index af054ece77..36a46dd208 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1732,6 +1732,8 @@ PROCESS is the process object for the current connection." (defvar rcirc-markup-text-functions '(rcirc-markup-attributes + rcirc-color-attributes + rcirc-remove-markup-codes rcirc-markup-my-nick rcirc-markup-urls rcirc-markup-keywords @@ -2715,20 +2717,70 @@ If ARG is given, opens the URL in a new browser window." (defun rcirc-markup-attributes (_sender _response) "Highlight IRC markup, indicated by ASCII control codes." - (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) + (while (re-search-forward + (rx (group (or #x02 #x1d #x1f #x1e #x11)) + (*? nonl) + (group (or (backref 1) (+ #x0f) eol))) + nil t) (rcirc-add-face (match-beginning 0) (match-end 0) - (cl-case (char-after (match-beginning 1)) - (?\C-b 'bold) - (?\C-v 'italic) - (?\C-_ 'underline))) - ;; keep the ^O since it could terminate other attributes - (when (not (eq ?\C-o (char-before (match-end 2)))) - (delete-region (match-beginning 2) (match-end 2))) - (delete-region (match-beginning 1) (match-end 1)) - (goto-char (match-beginning 1))) - ;; remove the ^O characters now - (goto-char (point-min)) - (while (re-search-forward "\C-o+" nil t) + (cl-case (char-after (match-beginning 0)) + (#x02 'bold) + (#x1d 'italic) + (#x1f 'underline) + (#x1e '(:strike-through t)) + (#x11 'rcirc-monospace-text))) + (goto-char (1+ (match-beginning 0))))) + +(defconst rcirc-color-codes + ;; Taken from https://modern.ircdocs.horse/formatting.html + ["white" "black" "blue" "green" "red" "brown" "magenta" + "orange" "yellow" "light green" "cyan" "light cyan" + "light blue" "pink" "grey" "light grey" + "#470000" "#472100" "#474700" "#324700" "#004700" "#00472c" + "#004747" "#002747" "#000047" "#2e0047" "#470047" "#47002a" + "#740000" "#743a00" "#747400" "#517400" "#007400" "#007449" + "#007474" "#004074" "#000074" "#4b0074" "#740074" "#740045" + "#b50000" "#b56300" "#b5b500" "#7db500" "#00b500" "#00b571" + "#00b5b5" "#0063b5" "#0000b5" "#7500b5" "#b500b5" "#b5006b" + "#ff0000" "#ff8c00" "#ffff00" "#b2ff00" "#00ff00" "#00ffa0" + "#00ffff" "#008cff" "#0000ff" "#a500ff" "#ff00ff" "#ff0098" + "#ff5959" "#ffb459" "#ffff71" "#cfff60" "#6fff6f" "#65ffc9" + "#6dffff" "#59b4ff" "#5959ff" "#c459ff" "#ff66ff" "#ff59bc" + "#ff9c9c" "#ffd39c" "#ffff9c" "#e2ff9c" "#9cff9c" "#9cffdb" + "#9cffff" "#9cd3ff" "#9c9cff" "#dc9cff" "#ff9cff" "#ff94d3" + "#000000" "#131313" "#282828" "#363636" "#4d4d4d" "#656565" + "#818181" "#9f9f9f" "#bcbcbc" "#e2e2e2" "#ffffff"] + "Vector of colors for each IRC color code.") + +(defun rcirc-color-attributes (_sender _response) + "Highlight IRC color-codes, indicated by ASCII control codes." + (while (re-search-forward + (rx #x03 + (? (group (= 2 digit)) (? "," (group (= 2 digit)))) + (*? nonl) + (or #x03 #x0f eol)) + nil t) + (let (foreground background) + (when-let ((fg-raw (match-string 1)) + (fg (string-to-number fg-raw)) + ((<= 0 fg (1- (length rcirc-color-codes))))) + (setq foreground (aref rcirc-color-codes fg))) + (when-let ((bg-raw (match-string 2)) + (bg (string-to-number bg-raw)) + ((<= 0 bg (1- (length rcirc-color-codes))))) + (setq background (aref rcirc-color-codes bg))) + (rcirc-add-face (match-beginning 0) (match-end 0) + `(face (:foreground + ,foreground + :background + ,background)))))) + +(defun rcirc-remove-markup-codes (_sender _response) + "Remove ASCII control codes used to designate markup." + (while (re-search-forward + (rx (or #x02 #x1d #x1f #x1e #x11 #x0f + (: #x03 (? (= 2 digit) (? "," (= 2 digit)))))) + nil t) (delete-region (match-beginning 0) (match-end 0)))) (defun rcirc-markup-my-nick (_sender response) @@ -3424,6 +3476,10 @@ object for the current connection." :group 'rcirc :group 'faces) +(defface rcirc-monospace-text + '((t :family "Monospace")) + "Face used for monospace text in messages.") + (defface rcirc-my-nick ; font-lock-function-name-face '((((class color) (min-colors 88) (background light)) :foreground "Blue1") (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") commit 3e318464680c4c24e10004155122ac7db7b9c123 Author: Philip Kaludercic Date: Mon Jun 14 18:02:24 2021 +0200 Fix construction of interactive specification in rcirc-define-command * rcirc.el (rcirc-define-command): Ensure that only one argument is passed. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 86f9ff048d..af054ece77 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2421,7 +2421,7 @@ that, an interactive form can specified." ,(concat documentation "\n\nNote: If PROCESS or TARGET are nil, the values given" "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - (interactive ,@interactive-spec) + (interactive (list ,@interactive-spec)) (unless (if (listp ,argument) (not (<= ,required (length ,argument) ,total)) (string-match ,regexp ,argument)) commit f1e79a33b5c453ee7185822a4673e930033e9640 Author: Philip Kaludercic Date: Mon Jun 14 13:25:57 2021 +0200 Rename set-rcirc-{encode,decode}-coding-system * rcirc.el (set-rcirc-decode-coding-system): Deprecate command (rcirc-set-decode-coding-system): New command (set-rcirc-encode-coding-system): Deprecate command (rcirc-set-encode-coding-system): New command diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index de42220f96..86f9ff048d 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1157,16 +1157,26 @@ The list is updated automatically by `defun-rcirc-command'.") '(metadata (cycle-sort-function . identity)) (complete-with-action action table str pred))))))) -(defun set-rcirc-decode-coding-system (coding-system) +(defun rcirc-set-decode-coding-system (coding-system) "Set the decode CODING-SYSTEM used in this channel." (interactive "zCoding system for incoming messages: ") (setq-local rcirc-decode-coding-system coding-system)) -(defun set-rcirc-encode-coding-system (coding-system) +(define-obsolete-function-alias + 'rcirc-set-decode-coding-system + 'set-rcirc-decode-coding-system + "28.1") + +(defun rcirc-set-encode-coding-system (coding-system) "Set the encode CODING-SYSTEM used in this channel." (interactive "zCoding system for outgoing messages: ") (setq-local rcirc-encode-coding-system coding-system)) +(define-obsolete-function-alias + 'rcirc-set-encode-coding-system + 'set-rcirc-encode-coding-system + "28.1") + (defvar rcirc-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'rcirc-send-input) commit 88e07af18cddbb0639b55ab21012eca1cd630b49 Author: Philip Kaludercic Date: Mon Jun 14 09:31:01 2021 +0200 Preserve order of completion during cycling * rcirc.el (rcirc-completion-at-point): Specify cycle-sort-function diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 9fdbf12cd8..de42220f96 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1151,7 +1151,11 @@ The list is updated automatically by `defun-rcirc-command'.") (lambda (str) (concat (funcall rcirc-nick-filter str) ": ")) (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target)))))) - (list beg (point) table)))) + (list beg (point) + (lambda (str pred action) + (if (eq action 'metadata) + '(metadata (cycle-sort-function . identity)) + (complete-with-action action table str pred))))))) (defun set-rcirc-decode-coding-system (coding-system) "Set the decode CODING-SYSTEM used in this channel." commit e17cc751baa17f142fbc41710bf645f6fdc64a80 Author: Philip Kaludercic Date: Sun Jun 13 21:10:25 2021 +0200 Add mouse properties to activity string * rcirc.el (rcirc-activity-string): Allow clicking on string diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 400facf344..9fdbf12cd8 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2211,7 +2211,6 @@ activity. Only run if the buffer is not visible and (defvar rcirc-update-activity-string-hook nil "Hook run whenever the activity string is updated.") -;; TODO: add mouse properties (defun rcirc-update-activity-string () "Update mode-line string." (let* ((pair (rcirc-split-activity rcirc-activity)) @@ -2238,12 +2237,17 @@ activity. Only run if the buffer is not visible and (let ((s (substring-no-properties (rcirc-short-buffer-name b)))) (with-current-buffer b (dolist (type rcirc-activity-types) - (rcirc-add-face 0 (length s) - (cl-case type + (rcirc-facify s (cl-case type (nick 'rcirc-track-nick) - (keyword 'rcirc-track-keyword)) - s))) - s)) + (keyword 'rcirc-track-keyword))))) + (let ((map (make-mode-line-mouse-map + 'mouse-1 + (lambda () + (interactive) + (pop-to-buffer b))))) + (propertize s + 'mouse-face 'mode-line-highlight + 'local-map map)))) buffers ",")) (defun rcirc-short-buffer-name (buffer) commit e61bdd5a96c2961dbbbdfc75a51ce573eaf71d1f Author: Philip Kaludercic Date: Sun Jun 13 20:00:59 2021 +0200 Update activity string after switching to next active buffer * rcirc.el (rcirc-next-active-buffer): Call rcirc-update-activity-string diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 50ddb6ca05..400facf344 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2154,7 +2154,8 @@ With prefix ARG, go to the next low priority buffer with activity." (concat " Type C-u " (key-description (this-command-keys)) " for low priority activity.") - ""))))) + "")))) + (rcirc-update-activity-string)) (define-obsolete-variable-alias 'rcirc-activity-hooks 'rcirc-activity-functions "24.3") commit a44e402b69b5d44afe1dfdd38fec7fcb57d8af38 Author: Philip Kaludercic Date: Thu Jun 10 19:44:00 2021 +0200 Preserve incoming order of messages with same timestamp * rcirc.el (rcirc-print): Emulate time-less-or-equal-p diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index abe4cfb0b3..50ddb6ca05 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1767,7 +1767,7 @@ connection." (goto-char (or (previous-single-property-change (point) 'hard) (point-min))) (when (let ((then (get-text-property (point) 'rcirc-time))) - (and then (time-less-p then time))) + (and then (not (time-less-p time then)))) (next-single-property-change (point) 'hard) (forward-char 1) (throw 'exit nil)))) commit fd96e3a0d9f8180ed4ef4829c7a738d10a4b858e Author: Philip Kaludercic Date: Thu Jun 10 17:38:44 2021 +0200 Allow hiding certain message types after reconnecting * rcirc.el (rcirc-omit-after-reconnect): Add new user option (rcirc-reconncting): Add new variable (rcirc-print): Check if message should be omitted (reconnect): Mark buffers as freshly reconnected diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4144a28278..abe4cfb0b3 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -194,6 +194,17 @@ If nil, no maximum is applied." "Responses which will be hidden when `rcirc-omit-mode' is enabled." :type '(repeat string)) +(defcustom rcirc-omit-after-reconnect + '("JOIN" "TOPIC" "NAMES") + "Types of messages to hide right after reconnecting." + :type '(repeat string) + :version "28.1") + +(defvar-local rcirc-reconncting nil + "Non-nil means we have just reconnected. +This is used to hide the message types enumerated in +`rcirc-supress-after-reconnect'.") + (defvar-local rcirc-prompt-start-marker nil "Marker indicating the beginning of the message prompt.") @@ -1795,7 +1806,10 @@ connection." ;; make text omittable (let ((last-activity-lines (rcirc-elapsed-lines process sender target))) (if (and (not (string= (rcirc-nick process) sender)) - (member response rcirc-omit-responses) + (or (member response rcirc-omit-responses) + (if (member response rcirc-omit-after-reconnect) + rcirc-reconncting + (setq rcirc-reconncting nil))) (or (not last-activity-lines) (< rcirc-omit-threshold last-activity-lines))) (put-text-property (point-min) (point-max) @@ -2465,6 +2479,9 @@ to `rcirc-default-part-reason'." (setf (nth 5 conn-info) (cl-remove-if-not #'rcirc-channel-p (mapcar #'car rcirc-buffer-alist))) + (dolist (buf (nth 5 conn-info)) + (with-current-buffer (cdr (assoc buf rcirc-buffer-alist)) + (setq rcirc-reconncting t))) (apply #'rcirc-connect conn-info)))))) (rcirc-define-command nick (nick) commit 3a61e7bca16fff559978ad9e2a4243250fde1835 Author: Philip Kaludercic Date: Thu Jun 10 17:15:17 2021 +0200 Use defvar-local instead of setq-local where applicable diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index c1f5643ec4..4144a28278 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -194,7 +194,7 @@ If nil, no maximum is applied." "Responses which will be hidden when `rcirc-omit-mode' is enabled." :type '(repeat string)) -(defvar rcirc-prompt-start-marker nil +(defvar-local rcirc-prompt-start-marker nil "Marker indicating the beginning of the message prompt.") (define-minor-mode rcirc-omit-mode @@ -396,16 +396,16 @@ will be killed." :version "28.1" :type 'function) -(defvar rcirc-nick nil +(defvar-local rcirc-nick nil "The nickname used for the current connection.") -(defvar rcirc-prompt-end-marker nil +(defvar-local rcirc-prompt-end-marker nil "Marker indicating the end of the message prompt.") -(defvar rcirc-nick-table nil +(defvar-local rcirc-nick-table nil "Hash table mapping nicks to channels.") -(defvar rcirc-recent-quit-alist nil +(defvar-local rcirc-recent-quit-alist nil "Alist of nicks that have recently quit or parted the channel.") (defvar rcirc-nick-syntax-table @@ -416,7 +416,7 @@ will be killed." table) "Syntax table which includes all nick characters as word constituents.") -(defvar rcirc-buffer-alist nil +(defvar-local rcirc-buffer-alist nil "Alist of (TARGET . BUFFER) pairs.") (defvar rcirc-activity nil @@ -426,16 +426,16 @@ will be killed." "String displayed in mode line representing `rcirc-activity'.") (put 'rcirc-activity-string 'risky-local-variable t) -(defvar rcirc-server-buffer nil +(defvar-local rcirc-server-buffer nil "The server buffer associated with this channel buffer.") -(defvar rcirc-server-parameters nil +(defvar-local rcirc-server-parameters nil "List of parameters received from the server.") -(defvar rcirc-target nil +(defvar-local rcirc-target nil "The channel or user associated with this buffer.") -(defvar rcirc-urls nil +(defvar-local rcirc-urls nil "List of URLs seen in the current buffer and their start positions.") (put 'rcirc-urls 'permanent-local t) @@ -443,7 +443,7 @@ will be killed." "Kill connection after this many seconds if there is no activity.") -(defvar rcirc-startup-channels nil +(defvar-local rcirc-startup-channels nil "List of channel names to join after authenticating.") (defvar rcirc-server-name-history nil @@ -551,32 +551,32 @@ If ARG is non-nil, instead prompt for connection parameters." (defalias 'irc 'rcirc) -(defvar rcirc-process-output nil +(defvar-local rcirc-process-output nil "Partial message response.") -(defvar rcirc-topic nil +(defvar-local rcirc-topic nil "Topic of the current channel.") (defvar rcirc-keepalive-timer nil "Timer for sending KEEPALIVE message.") -(defvar rcirc-last-server-message-time nil +(defvar-local rcirc-last-server-message-time nil "Timestamp for the last server response.") -(defvar rcirc-server nil +(defvar-local rcirc-server nil "Server provided by server.") -(defvar rcirc-server-name nil +(defvar-local rcirc-server-name nil "Server name given by 001 response.") -(defvar rcirc-timeout-timer nil +(defvar-local rcirc-timeout-timer nil "Timer for determining a network timeout.") -(defvar rcirc-user-authenticated nil +(defvar-local rcirc-user-authenticated nil "Flag indicating if the user is authenticated.") -(defvar rcirc-user-disconnect nil +(defvar-local rcirc-user-disconnect nil "Flag indicating if the connection was broken.") -(defvar rcirc-connecting nil +(defvar-local rcirc-connecting nil "Flag indicating if the connection is being established.") -(defvar rcirc-connection-info nil +(defvar-local rcirc-connection-info nil "Information about the current connection. If defined, it is a list of this form (SERVER PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS). See `rcirc-connect' for more details on these variables.") -(defvar rcirc-process nil +(defvar-local rcirc-process nil "Network process for the current connection.") ;;; IRCv3 capability negotiation (https://ircv3.net/specs/extensions/capability-negotiation) @@ -626,25 +626,18 @@ that are joined after authentication." (set-process-sentinel process 'rcirc-sentinel) (set-process-filter process 'rcirc-filter) - (setq-local rcirc-connection-info - (list server port nick user-name full-name startup-channels - password encryption server-alias)) - (setq-local rcirc-process process) - (setq-local rcirc-server server) - (setq-local rcirc-server-name - (or server-alias server)) ; Update when we get 001 response. - (setq-local rcirc-buffer-alist nil) - (setq-local rcirc-nick-table (make-hash-table :test 'equal)) - (setq-local rcirc-nick nick) - (setq-local rcirc-process-output nil) - (setq-local rcirc-startup-channels startup-channels) - (setq-local rcirc-last-server-message-time (current-time)) - - (setq-local rcirc-timeout-timer nil) - (setq-local rcirc-user-disconnect nil) - (setq-local rcirc-user-authenticated nil) - (setq-local rcirc-connecting t) - (setq-local rcirc-server-parameters nil) + (setq rcirc-connection-info + (list server port nick user-name full-name startup-channels + password encryption server-alias)) + (setq rcirc-process process) + (setq rcirc-server server) + (setq rcirc-server-name (or server-alias server)) ; Update when we get 001 response. + (setq rcirc-nick-table (make-hash-table :test 'equal)) + (setq rcirc-nick nick) + (setq rcirc-startup-channels startup-channels) + (setq rcirc-last-server-message-time (current-time)) + + (setq rcirc-connecting t) (add-hook 'auto-save-hook 'rcirc-log-write) @@ -756,7 +749,7 @@ When 0, do not auto-reconnect." :version "25.1" :type 'integer) -(defvar rcirc-last-connect-time nil +(defvar-local rcirc-last-connect-time nil "The last time the buffer was connected.") (defun rcirc-sentinel (process sentinel) @@ -1070,10 +1063,10 @@ If SILENT is non-nil, do not print the message in any irc buffer." (unless silent (rcirc-print process (rcirc-nick process) response target msg))))) -(defvar rcirc-input-ring nil +(defvar-local rcirc-input-ring nil "Ring object for input.") -(defvar rcirc-input-ring-index 0 +(defvar-local rcirc-input-ring-index 0 "Current position in the input ring.") (defun rcirc-prev-input-string (arg) @@ -1187,20 +1180,20 @@ The list is updated automatically by `defun-rcirc-command'.") map) "Keymap for rcirc mode.") -(defvar rcirc-short-buffer-name nil +(defvar-local rcirc-short-buffer-name nil "Generated abbreviation to use to indicate buffer activity.") (defvar rcirc-mode-hook nil "Hook run when setting up rcirc buffer.") -(defvar rcirc-last-post-time nil +(defvar-local rcirc-last-post-time nil "Timestamp indicating last user action.") (defvar rcirc-log-alist nil "Alist of lines to log to disk when `rcirc-log-flag' is non-nil. Each element looks like (FILENAME . TEXT).") -(defvar rcirc-current-line 0 +(defvar-local rcirc-current-line 0 "The current number of responses printed in this channel. This number is independent of the number of lines in the buffer.") @@ -1215,7 +1208,7 @@ This number is independent of the number of lines in the buffer.") (setq major-mode 'rcirc-mode) (setq mode-line-process nil) - (setq-local rcirc-input-ring + (setq rcirc-input-ring ;; If rcirc-input-ring is already a ring with desired ;; size do not re-initialize. (if (and (ring-p rcirc-input-ring) @@ -1223,18 +1216,14 @@ This number is independent of the number of lines in the buffer.") rcirc-input-ring-size)) rcirc-input-ring (make-ring rcirc-input-ring-size))) - (setq-local rcirc-server-buffer (process-buffer process)) - (setq-local rcirc-target target) - (setq-local rcirc-topic nil) - (setq-local rcirc-last-post-time (current-time)) + (setq rcirc-server-buffer (process-buffer process)) + (setq rcirc-target target) + (setq rcirc-last-post-time (current-time)) (setq-local fill-paragraph-function 'rcirc-fill-paragraph) - (setq-local rcirc-recent-quit-alist nil) - (setq-local rcirc-current-line 0) - (setq-local rcirc-last-connect-time (current-time)) + (setq rcirc-current-line 0) + (setq rcirc-last-connect-time (current-time)) (use-hard-newlines t) - (setq-local rcirc-short-buffer-name nil) - (setq-local rcirc-urls nil) ;; setup for omitting responses (setq buffer-invisibility-spec '()) @@ -1255,8 +1244,8 @@ This number is independent of the number of lines in the buffer.") (if (consp (cdr i)) (cddr i) (cdr i)))))) ;; setup the prompt and markers - (setq-local rcirc-prompt-start-marker (point-max-marker)) - (setq-local rcirc-prompt-end-marker (point-max-marker)) + (setq rcirc-prompt-start-marker (point-max-marker)) + (setq rcirc-prompt-end-marker (point-max-marker)) (rcirc-update-prompt) (goto-char rcirc-prompt-end-marker) commit 13f6f78473436ee5e0127f5ae993710cd7cddd4b Author: Philip Kaludercic Date: Thu Jun 10 11:42:09 2021 +0200 Allow for optional arguments using rcirc-define-command * rcirc.el (rcirc-define-command): Handle &optional arguments diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index edd5b87e7d..c1f5643ec4 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2363,25 +2363,33 @@ prefix with another element in PAIRS." (defmacro rcirc-define-command (command arguments &rest body) "Define a new client COMMAND in BODY that takes ARGUMENTS. -Just like `defun', a string at the beginning of BODY is -interpreted as the documentation string. Following that, an -interactive form can specified." +ARGUMENTS may designate optional arguments using a single +`&optional' symbol. Just like `defun', a string at the beginning +of BODY is interpreted as the documentation string. Following +that, an interactive form can specified." (declare (debug (symbolp (&rest symbolp) def-body)) (indent defun)) (cl-check-type command symbol) (cl-check-type arguments list) - (let ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command))) ) - (regexp (with-temp-buffer - (insert "\\`") - (when arguments - (dotimes (_ (1- (length arguments))) - (insert "\\(.+?\\)[[:space:]]*")) - (insert "\\(.*\\)")) - (insert "[[:space:]]*\\'") - (buffer-string))) - (argument (gensym)) - documentation - interactive-spec) + (let* ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command)))) + (total (length (remq '&optional arguments))) + (required (- (length arguments) (length (memq '&optional arguments)))) + (optional (- total required)) + (regexp (with-temp-buffer + (insert "\\`") + (when arguments + (dotimes (_ (1- (length arguments))) + (insert "\\(?:\\(.+?\\)[[:space:]]*")) + (insert "\\(.*\\)") + (dotimes (i (1- (length arguments))) + (when (< i optional) + (insert "?")) + (insert "\\)"))) + (insert "[[:space:]]*\\'") + (buffer-string))) + (argument (gensym)) + documentation + interactive-spec) (when (stringp (car body)) (setq documentation (pop body))) (when (eq (car-safe (car-safe body)) 'interactive) @@ -2393,17 +2401,17 @@ interactive form can specified." "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") (interactive ,@interactive-spec) (unless (if (listp ,argument) - (= (length ,argument) ,(length arguments)) + (not (<= ,required (length ,argument) ,total)) (string-match ,regexp ,argument)) (user-error "Malformed input: %S" ',arguments)) (let ((process (or process (rcirc-buffer-process))) (target (or target rcirc-target))) (ignore target process) (let (,@(cl-loop - for i from 0 for arg in arguments + for i from 0 for arg in (delq '&optional arguments) collect `(,arg (if (listp ,argument) - (nth ,i ,argument) - (match-string ,(1+ i) ,argument))))) + (nth ,i ,argument) + (match-string ,(1+ i) ,argument))))) ,@body))) (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))))) @@ -2442,30 +2450,22 @@ CHANNELS is a comma- or space-separated string of channel names." (read-string "Channel: "))) (rcirc-send-string process "INVITE" nick channel)) -(rcirc-define-command part (channel) +(rcirc-define-command part (&optional channel reason) "Part CHANNEL. CHANNEL should be a string of the form \"#CHANNEL-NAME REASON\". If omitted, CHANNEL-NAME defaults to TARGET, and REASON defaults to `rcirc-default-part-reason'." - (interactive "sPart channel: ") - (let ((channel (if (> (length channel) 0) channel target)) - (msg rcirc-default-part-reason)) - (when (string-match "\\`\\([&#+!]\\S-+\\)?\\s-*\\(.+\\)?\\'" channel) - (when (match-beginning 2) - (setq msg (match-string 2 channel))) - (setq channel (if (match-beginning 1) - (match-string 1 channel) - target))) - (rcirc-send-string process "PART" channel : msg))) - -(rcirc-define-command quit (reason) + (interactive "sPart channel: \nsReason: ") + (rcirc-send-string process "PART" (or channel target) + : (or reason rcirc-default-part-reason))) + +(rcirc-define-command quit (&optional reason) "Send a quit message to server with REASON." (interactive "sQuit reason: ") - (rcirc-send-string process "QUIT" : (if (not (zerop (length reason))) - reason - rcirc-default-quit-reason))) + (rcirc-send-string process "QUIT" + : (or reason rcirc-default-quit-reason))) -(rcirc-define-command reconnect (_) +(rcirc-define-command reconnect () "Reconnect to current server." (interactive "i") (with-rcirc-server-buffer @@ -2483,15 +2483,12 @@ to `rcirc-default-part-reason'." (interactive (list (read-string "New nick: "))) (rcirc-send-string process "NICK" nick)) -(rcirc-define-command names (channel) +(rcirc-define-command names (&optional channel) "Display list of names in CHANNEL or in current channel if CHANNEL is nil. If called interactively, prompt for a channel when prefix arg is supplied." (interactive (list (and current-prefix-arg (read-string "List names in channel: ")))) - (let ((channel (if (> (length channel) 0) - channel - target))) - (rcirc-send-string process "NAMES" channel))) + (rcirc-send-string process "NAMES" (or channel target))) (rcirc-define-command topic (topic) "List TOPIC for the TARGET channel. commit b67b1eea256e05cc65039f207d0f16a16e2dac4e Author: Philip Kaludercic Date: Thu Jun 10 11:40:19 2021 +0200 Fix prompt doubling when reconnecting * rcirc.el (rcirc-connect): Check if rcirc-mode is already active (rcirc-get-buffer-create): Check if rcirc-mode is already active diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index ad5a4d6417..edd5b87e7d 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -621,7 +621,8 @@ that are joined after authentication." (set-process-coding-system process 'raw-text 'raw-text) (switch-to-buffer (rcirc-generate-new-buffer-name process nil)) (set-process-buffer process (current-buffer)) - (rcirc-mode process nil) + (unless (eq major-mode 'rcirc-mode) + (rcirc-mode process nil)) (set-process-sentinel process 'rcirc-sentinel) (set-process-filter process 'rcirc-filter) @@ -662,6 +663,7 @@ that are joined after authentication." (run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive))) (message "Connecting to %s...done" (or server-alias server)) + (setq mode-line-process nil) ;; return process object process))) @@ -1412,9 +1414,11 @@ Create the buffer if it doesn't exist." (let ((new-buffer (get-buffer-create (rcirc-generate-new-buffer-name process target)))) (with-current-buffer new-buffer - (rcirc-mode process target) + (unless (eq major-mode 'rcirc-mode) + (rcirc-mode process target))) + (setq mode-line-process nil) (rcirc-put-nick-channel process (rcirc-nick process) target - rcirc-current-line)) + rcirc-current-line) new-buffer))))) (defun rcirc-send-input () commit 95fdd4b99bccc11f373c3b9d6cacee8269728344 Author: Philip Kaludercic Date: Thu Jun 10 00:22:36 2021 +0200 Allow filtering how nicks are presented * rcirc.el (rcirc-nick-filter): Add new option (rcirc-completion-at-point): Use rcirc-nick-filter (rcirc-format-response-string): Use rcirc-nick-filter (rcirc-sort-nicknames-join): Use rcirc-nick-filter diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index b3b70a6816..ad5a4d6417 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -391,6 +391,11 @@ will be killed." :version "24.3" :type 'boolean) +(defcustom rcirc-nick-filter #'identity + "Function applied to nicknames before displaying." + :version "28.1" + :type 'function) + (defvar rcirc-nick nil "The nickname used for the current connection.") @@ -1118,11 +1123,13 @@ The list is updated automatically by `defun-rcirc-command'.") rcirc-prompt-end-marker))) (table (cond ;; No completion before the prompt - ((< beg rcirc-prompt-end-marker) nil) + ((< beg rcirc-prompt-end-marker) nil) ;; Only complete nicks mid-message ((> beg rcirc-prompt-end-marker) - (rcirc-channel-nicks (rcirc-buffer-process) - rcirc-target)) + (mapcar rcirc-nick-filter + (rcirc-channel-nicks + (rcirc-buffer-process) + rcirc-target))) ;; Complete commands at the beginning of the ;; message, when the first character is a dash ((eq (char-after beg) ?/) @@ -1135,7 +1142,7 @@ The list is updated automatically by `defun-rcirc-command'.") ;; Complete usernames right after the prompt by ;; appending a colon after the name ((mapcar - (lambda (str) (concat str ": ")) + (lambda (str) (concat (funcall rcirc-nick-filter str) ": ")) (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target)))))) (list beg (point) table)))) @@ -1601,7 +1608,7 @@ communication." (sender (if (or (not sender) (string= (rcirc-server-name process) sender)) "" - sender)) + (funcall rcirc-nick-filter sender))) face) (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t) (rcirc-add-face start (match-beginning 0) face) @@ -2044,7 +2051,7 @@ INPUT is a string containing nicknames separated by SEP. This function does not alter the INPUT string." (let* ((parts (split-string input sep t)) (sorted (sort parts 'rcirc-nickname<))) - (mapconcat 'identity sorted sep))) + (mapconcat rcirc-nick-filter sorted sep))) ;;; activity tracking (defvar rcirc-track-minor-mode-map commit f6e18c63a63fdac0d6abc6a6f68d670ab2923269 Author: Philip Kaludercic Date: Wed Jun 9 20:27:10 2021 +0200 Implement invite-notify capability * rcirc.el (rcirc-implemented-capabilities): Add invite-notify (rcirc-handler-INVITE): Handle invite notifications diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 60cafd4dad..b3b70a6816 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -580,6 +580,7 @@ See `rcirc-connect' for more details on these variables.") "server-time" ;https://ircv3.net/specs/extensions/server-time "batch" ;https://ircv3.net/specs/extensions/batch "message-ids" ;https://ircv3.net/specs/extensions/message-ids + "invite-notify" ;https://ircv3.net/specs/extensions/invite-notify ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -3247,11 +3248,21 @@ Passwords are stored in `rcirc-authinfo' (which see)." (format "AUTH %s %s" nick (car args)))))))))) (defun rcirc-handler-INVITE (process sender args _text) - "Notify user of an invitation. -SENDER and ARGS (in concatenated form) are passed on to -`rcirc-print'. PROCESS is the process object for the current -connection." - (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t)) + "Notify user of an invitation from SENDER. +ARGS should have the form (TARGET CHANNEL). PROCESS is the +process object for the current connection." + (let ((self (buffer-local-value 'rcirc-nick rcirc-process)) + (target (car args)) + (chan (cadr args))) + (if (string= target self) + (rcirc-print process sender "INVITE" nil + (format "%s invited you to %s" + sender chan) + t) + (rcirc-print process sender "INVITE" chan + (format "%s invited %s" + sender target) + t)))) (defun rcirc-handler-ERROR (process sender args _text) "Print a error message. commit c300326fa01cb9532e0399047a1ebdede5e2f65d Author: Philip Kaludercic Date: Wed Jun 9 18:44:55 2021 +0200 Add TAGMSG handler * rcirc.el (rcirc-handler-TAGMSG): Add new message handler diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 12e1fc3b2e..60cafd4dad 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -3322,6 +3322,14 @@ is the process object for the current connection." ;; All requested capabilities have been responded to (rcirc-send-string process "CAP" "END")))) +(defun rcirc-handler-TAGMSG (process sender _args _text) + "Handle a empty tag message from SENDER. +PROCESS is the process object for the current connection." + (dolist (tag rcirc-message-tags) + (when-let ((handler (intern-soft (concat "rcirc-tag-handler-" (car tag)))) + ((fboundp handler))) + (funcall handler process sender (cdr tag))))) + (defun rcirc-handler-BATCH (process _sender args _text) "Open or close a batch. ARGS should have the form (tag type . parameters) when starting a commit 567e288eb9e89c768ff7ed6de256319007432ef7 Author: Philip Kaludercic Date: Wed Jun 9 17:58:52 2021 +0200 Implement message-ids extension * rcirc.el (rcirc-implemented-capabilities): Add to list of implemented extensions (rcirc-print): Insert property denoting message ID diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 918b716bc7..12e1fc3b2e 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -579,6 +579,7 @@ See `rcirc-connect' for more details on these variables.") '("message-tags" ;https://ircv3.net/specs/extensions/message-tags "server-time" ;https://ircv3.net/specs/extensions/server-time "batch" ;https://ircv3.net/specs/extensions/batch + "message-ids" ;https://ircv3.net/specs/extensions/message-ids ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -1766,9 +1767,10 @@ connection." (save-excursion (save-restriction (narrow-to-region (point) (point)) - (insert (rcirc-format-response-string process sender response - nil text) - (propertize "\n" 'hard t)) + (insert (propertize (rcirc-format-response-string process sender response + nil text) + 'rcirc-msgid (rcirc-get-tag "msgid")) + (propertize "\n" 'hard t)) ;; squeeze spaces out of text before rcirc-text (fill-region (point-min) (point-max)) commit ab49a9a6342eb6a4a1c0032a5848dd8538c6ccea Author: Philip Kaludercic Date: Wed Jun 9 17:57:21 2021 +0200 Implement batch extension * rcirc.el (rcirc-implemented-capabilities): Add batch extension (rcirc-supported-batch-types): Add new variable (rcirc-batch-attributes): Add new variable (rcirc-batched-messages): Add new variable (rcirc-process-server-response-1): Handle messages with batch tag (rcirc-handler-BATCH): Add batch dispatcher diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 68cc7a08a6..918b716bc7 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -578,6 +578,7 @@ See `rcirc-connect' for more details on these variables.") (defvar rcirc-implemented-capabilities '("message-tags" ;https://ircv3.net/specs/extensions/message-tags "server-time" ;https://ircv3.net/specs/extensions/server-time + "batch" ;https://ircv3.net/specs/extensions/batch ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -867,6 +868,22 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (defvar rcirc-message-tags nil "Alist of parsed message tags.") +(defvar rcirc-supported-batch-types + '() + "List of recognized batch types. +Each element has the form (TYPE HANDLE), where TYPE is a string +and HANDLE is either the symbol `immediate' or `deferred'. +Messages in an immediate batch are handled just like regular +messages, while deferred messages are stored in +`rcirc-batch-messages'.") + +(defvar-local rcirc-batch-attributes nil + "Alist mapping batch IDs to parameters.") + +(defvar-local rcirc-batched-messages nil + "Alist mapping batch IDs to deferred messages. +Note that the messages are stored in reverse order.") + (defsubst rcirc-get-tag (key &optional default) "Return tag value for KEY or DEFAULT." (alist-get key rcirc-message-tags default nil #'string=)) @@ -915,9 +932,18 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (push (substring text (match-end 0)) args) (cl-assert (= i (length text)))) (cl-callf nreverse args))) - (if (not (fboundp handler)) - (rcirc-handler-generic process cmd sender args text) - (funcall handler process sender args text)) + (cond ((and-let* ((batch-id (rcirc-get-tag "batch")) + (type (cadr (assoc batch-id rcirc-batch-attributes))) + (attr (assoc type rcirc-supported-batch-types)) + ((eq (cadr attr) 'deferred))) + ;; handle deferred batch messages later + (push (list cmd process sender args text rcirc-message-tags) + (alist-get batch-id rcirc-batched-messages + nil nil #'string=)) + t)) + ((not (fboundp handler)) + (rcirc-handler-generic process cmd sender args text)) + ((funcall handler process sender args text))) (run-hook-with-args 'rcirc-receive-message-functions process cmd sender args text)) (message "UNHANDLED: %s" text))) @@ -3294,6 +3320,50 @@ is the process object for the current connection." ;; All requested capabilities have been responded to (rcirc-send-string process "CAP" "END")))) +(defun rcirc-handler-BATCH (process _sender args _text) + "Open or close a batch. +ARGS should have the form (tag type . parameters) when starting a +batch, or (tag) when closing a batch. PROCESS is the process +object for the current connection." + (with-rcirc-process-buffer process + (let ((type (cadr args)) + (id (substring (car args) 1))) + (cond + ((= (aref (car args) 0) ?+) ;start a new batch + (when (assoc id rcirc-batch-attributes) + (error "Starting batch with already used ID")) + (setf (alist-get id rcirc-batch-attributes nil nil #'string=) + (cons type (cddr args)))) + ((= (aref (car args) 0) ?-) ;close a batch + (unless (assoc id rcirc-batch-attributes) + (error "Closing a unknown batch")) + (let ((type (car (alist-get id rcirc-batch-attributes + nil nil #'string=)))) + (when (eq (car (alist-get type rcirc-supported-batch-types + nil nil #'string=)) + 'deferred) + (let ((messages (alist-get id rcirc-batched-messages + nil nil #'string=)) + (bhandler (intern-soft (concat "rcirc-batch-handler-" type)))) + (if (fboundp bhandler) + (funcall bhandler process id (nreverse messages)) + (dolist (message (nreverse messages)) + (let ((cmd (nth 0 message)) + (process (nth 1 message)) + (sender (nth 2 message)) + (args (nth 3 message)) + (text (nth 4 message)) + (rcirc-message-tags (nth 5 message))) + (if-let (handler (intern-soft (concat "rcirc-handler-" cmd))) + (funcall handler process sender args text) + (rcirc-handler-generic process cmd sender args text)))))))) + (setq rcirc-batch-attributes + (delq (assoc id rcirc-batch-attributes) + rcirc-batch-attributes) + rcirc-batched-messages + (delq (assoc id rcirc-batched-messages) + rcirc-batched-messages))))))) + (defgroup rcirc-faces nil "Faces for rcirc." commit 849e71fd83fa8796198035464897bf2f28f6226c Author: Philip Kaludercic Date: Wed Jun 9 17:55:55 2021 +0200 Implement server-time extension * rcirc.el (rcirc-implemented-capabilities): Add new capability (rcirc-print): Insert messages in the right position (rcirc-log): Use right time value (rcirc-markup-timestamp): Use right time value diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index f86b2b9ac9..68cc7a08a6 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -577,6 +577,7 @@ See `rcirc-connect' for more details on these variables.") ;;; IRCv3 capability negotiation (https://ircv3.net/specs/extensions/capability-negotiation) (defvar rcirc-implemented-capabilities '("message-tags" ;https://ircv3.net/specs/extensions/message-tags + "server-time" ;https://ircv3.net/specs/extensions/server-time ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -1702,11 +1703,13 @@ connection." ;; do not ignore if we sent the message (not (string= sender (rcirc-nick process)))) (let* ((buffer (rcirc-target-buffer process sender response target text)) + (time (if-let ((time (rcirc-get-tag "time"))) + (parse-iso8601-time-string time) + (current-time))) (inhibit-read-only t)) (with-current-buffer buffer (let ((moving (= (point) rcirc-prompt-end-marker)) - (old-point (point-marker)) - (fill-start (marker-position rcirc-prompt-start-marker))) + (old-point (point-marker))) (setq text (decode-coding-string text rcirc-decode-coding-system)) (unless (string= sender (rcirc-nick process)) @@ -1720,25 +1723,31 @@ connection." ;; temporarily set the marker insertion-type because ;; insert-before-markers results in hidden text in new buffers (goto-char rcirc-prompt-start-marker) + (catch 'exit + (while (not (bobp)) + (goto-char (or (previous-single-property-change (point) 'hard) + (point-min))) + (when (let ((then (get-text-property (point) 'rcirc-time))) + (and then (time-less-p then time))) + (next-single-property-change (point) 'hard) + (forward-char 1) + (throw 'exit nil)))) (set-marker-insertion-type rcirc-prompt-start-marker t) (set-marker-insertion-type rcirc-prompt-end-marker t) - (let ((start (point))) - (insert (rcirc-format-response-string process sender response nil - text) - (propertize "\n" 'hard t)) - - ;; squeeze spaces out of text before rcirc-text - (fill-region fill-start - (1- (or (next-single-property-change fill-start - 'rcirc-text) - rcirc-prompt-end-marker))) - - ;; run markup functions - (save-excursion - (save-restriction - (narrow-to-region start rcirc-prompt-start-marker) - (goto-char (or (next-single-property-change start 'rcirc-text) + ;; run markup functions + (cl-assert (bolp)) + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (insert (rcirc-format-response-string process sender response + nil text) + (propertize "\n" 'hard t)) + + ;; squeeze spaces out of text before rcirc-text + (fill-region (point-min) (point-max)) + + (goto-char (or (next-single-property-change (point-min) 'rcirc-text) (point))) (when (rcirc-buffer-process) (save-excursion (rcirc-markup-timestamp sender response)) @@ -1749,14 +1758,18 @@ connection." (when rcirc-read-only-flag (add-text-properties (point-min) (point-max) - '(read-only t front-sticky t)))) - ;; make text omittable + '(read-only t front-sticky t))) + + (add-text-properties (point-min) (point-max) + (list 'rcirc-time time)) + + ;; make text omittable (let ((last-activity-lines (rcirc-elapsed-lines process sender target))) (if (and (not (string= (rcirc-nick process) sender)) (member response rcirc-omit-responses) (or (not last-activity-lines) (< rcirc-omit-threshold last-activity-lines))) - (put-text-property (1- start) (1- rcirc-prompt-start-marker) + (put-text-property (point-min) (point-max) 'invisible 'rcirc-omit) ;; otherwise increment the line count (setq rcirc-current-line (1+ rcirc-current-line)))))) @@ -1778,11 +1791,11 @@ connection." (window-buffer w)) (>= (window-point w) rcirc-prompt-end-marker)) - (set-window-point w (point-max)))) + (set-window-point w (point-max)))) nil t) ;; restore the point - (goto-char (if moving rcirc-prompt-end-marker old-point)) + (goto-char (if moving rcirc-prompt-end-marker old-point))) ;; keep window on bottom line if it was already there (when rcirc-scroll-show-maximum-output @@ -1799,26 +1812,26 @@ connection." ;; flush undo (can we do something smarter here?) (buffer-disable-undo) - (buffer-enable-undo)) - - ;; record mode line activity - (when (and activity - (not rcirc-ignore-buffer-activity-flag) - (not (and rcirc-dim-nicks sender - (string-match (regexp-opt rcirc-dim-nicks) sender) - (rcirc-channel-p target)))) - (rcirc-record-activity (current-buffer) - (when (not (rcirc-channel-p rcirc-target)) - 'nick))) - - (when (and rcirc-log-flag - (or target - rcirc-log-process-buffers)) - (rcirc-log process sender response target text)) - - (sit-for 0) ; displayed text before hook - (run-hook-with-args 'rcirc-print-functions - process sender response target text))))) + (buffer-enable-undo) + + ;; record mode line activity + (when (and activity + (not rcirc-ignore-buffer-activity-flag) + (not (and rcirc-dim-nicks sender + (string-match (regexp-opt rcirc-dim-nicks) sender) + (rcirc-channel-p target)))) + (rcirc-record-activity (current-buffer) + (when (not (rcirc-channel-p rcirc-target)) + 'nick))) + + (when (and rcirc-log-flag + (or target + rcirc-log-process-buffers)) + (rcirc-log process sender response target text)) + + (sit-for 0) ; displayed text before hook + (run-hook-with-args 'rcirc-print-functions + process sender response target text))))) (defun rcirc-generate-log-filename (process target) "Return filename for log file based on PROCESS and TARGET." @@ -1846,10 +1859,12 @@ guarantee valid filenames for the current OS." "Record TEXT from SENDER to TARGET to be logged. The message is logged in `rcirc-log', and is later written to disk. PROCESS is the process object for the current connection." - (let ((filename (funcall rcirc-log-filename-function process target))) + (let ((filename (funcall rcirc-log-filename-function process target)) + (time (and-let* ((time (rcirc-get-tag "time"))) + (parse-iso8601-time-string time)))) (unless (null filename) (let ((cell (assoc-string filename rcirc-log-alist)) - (line (concat (format-time-string rcirc-time-format) + (line (concat (format-time-string rcirc-time-format time) (substring-no-properties (rcirc-format-response-string process sender response target text)) @@ -2631,8 +2646,10 @@ If ARG is given, opens the URL in a new browser window." (defun rcirc-markup-timestamp (_sender _response) "Insert a timestamp." (goto-char (point-min)) - (insert (rcirc-facify (format-time-string rcirc-time-format) - 'rcirc-timestamp))) + (let ((time (and-let* ((time (rcirc-get-tag "time"))) + (parse-iso8601-time-string time)))) + (insert (rcirc-facify (format-time-string rcirc-time-format time) + 'rcirc-timestamp)))) (defun rcirc-markup-attributes (_sender _response) "Highlight IRC markup, indicated by ASCII control codes." commit 06af44e3e180aa6ecbfc51d9e977757a6fabbc23 Author: Philip Kaludercic Date: Wed Jun 9 17:37:24 2021 +0200 Create framework for IRCv3 support * rcirc.el (rcirc-implemented-capabilities): Add new variable (rcirc-requested-capabilities): Add new variable (rcirc-acked-capabilities): Add new variable (rcirc-connect): Request capabilities from rcirc-implemented-capabilities (rcirc-process-regexp): Extend rcirc-process-regexp with tag support (rcirc-tag-regexp): Add new tokenizer for tags (rcirc-message-tags): Add new variable (rcirc-get-tag): Add new function (rcirc-process-server-response-1): Parse message-tags (rcirc-handler-CAP): Add new handler for capability requests diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 1b3601771b..f86b2b9ac9 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -45,6 +45,7 @@ (require 'ring) (require 'time-date) (require 'auth-source) +(require 'parse-time) (eval-when-compile (require 'subr-x)) (eval-when-compile (require 'rx)) @@ -573,6 +574,16 @@ See `rcirc-connect' for more details on these variables.") (defvar rcirc-process nil "Network process for the current connection.") +;;; IRCv3 capability negotiation (https://ircv3.net/specs/extensions/capability-negotiation) +(defvar rcirc-implemented-capabilities + '("message-tags" ;https://ircv3.net/specs/extensions/message-tags + ) + "A list of capabilities that rcirc supports.") +(defvar-local rcirc-requested-capabilities nil + "A list of capabilities that client has requested.") +(defvar-local rcirc-acked-capabilities nil + "A list of capabilities that the server supports.") + ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption @@ -628,6 +639,9 @@ that are joined after authentication." (add-hook 'auto-save-hook 'rcirc-log-write) ;; identify + (dolist (cap rcirc-implemented-capabilities) + (rcirc-send-string process "CAP" "REQ" : cap) + (push cap rcirc-requested-capabilities)) (unless (zerop (length password)) (rcirc-send-string process "PASS" password)) (rcirc-send-string process "NICK" nick) @@ -820,24 +834,74 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (rcirc-process-server-response-1 process text))) (defconst rcirc-process-regexp - ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1. We're a - ;; bit more accepting than the RFC: We allow any non-space - ;; characters in the command name, multiple spaces between - ;; arguments, and allow the last argument to omit the leading ":", - ;; even if there are less than 15 arguments. - (rx line-start - (optional - (group ":" (group (one-or-more (not (any " ")))) " ")) - (group (one-or-more (not (any " "))))) + (rx-let ((message-tag ; message tags as specified in + ; https://ircv3.net/specs/extensions/message-tags + (: (? "+") + (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/") + (+ (any alnum "-")) + (? "=" + (* (not (any 0 ?\n ?\r ?\; ?\s))))))) + (rx line-start + (optional "@" (group message-tag (* ";" message-tag)) (+ space)) + ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1. + ;; We're a bit more accepting than the RFC: We allow any non-space + ;; characters in the command name, multiple spaces between + ;; arguments, and allow the last argument to omit the leading ":", + ;; even if there are less than 15 arguments. + (optional + (group ":" (group (one-or-more (not (any " ")))) " ")) + (group (one-or-more (not (any " ")))))) "Regular expression used for parsing server response.") +(defconst rcirc-tag-regexp + (rx bos + (group + (? "+") + (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/") + (+ (any alnum "-"))) + (? "=" (group (* (not (any 0 ?\n ?\r ?\; ?\s))))) + eos) + "Regular expression used for destructing a tag.") + +(defvar rcirc-message-tags nil + "Alist of parsed message tags.") + +(defsubst rcirc-get-tag (key &optional default) + "Return tag value for KEY or DEFAULT." + (alist-get key rcirc-message-tags default nil #'string=)) + (defun rcirc-process-server-response-1 (process text) "Parse TEXT as received from PROCESS." (if (string-match rcirc-process-regexp text) - (let* ((user (match-string 2 text)) + (let* ((rcirc-message-tags + (append + (and-let* ((tag-data (match-string 1 text))) + (save-match-data + (mapcar + (lambda (tag) + (unless (string-match rcirc-tag-regexp tag) + ;; This should not happen, unless there is + ;; a mismatch between this regular + ;; expression and `rcirc-process-regexp'. + (error "Malformed tag %S" tag)) + (cons (match-string 1 tag) + (replace-regexp-in-string + (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n)) + (lambda (rep) + (concat (substring rep 0 -2) + (cl-case (aref rep (1- (length rep))) + (?: ";") + (?s " ") + (?\\ "\\\\") + (?r "\r") + (?n "\n")))) + (match-string 2 tag)))) + (split-string tag-data ";")))) + rcirc-message-tags)) + (user (match-string 3 text)) (sender (rcirc-user-nick user)) - (cmd (match-string 3 text)) - (cmd-end (match-end 3)) + (cmd (match-string 4 text)) + (cmd-end (match-end 4)) (args nil) (handler (intern-soft (concat "rcirc-handler-" cmd)))) (cl-loop with i = cmd-end @@ -3195,6 +3259,24 @@ PROCESS is the process object for the current connection." PROCESS is the process object for the current connection." (rcirc-print process sender "CTCP" nil message t)) +(defun rcirc-handler-CAP (process _sender args _text) + "Handle capability negotiation messages. +ARGS should have the form (USER SUBCOMMAND . ARGUMENTS). PROCESS +is the process object for the current connection." + (with-rcirc-process-buffer process + (let ((subcmd (cadr args))) + (dolist (cap (cddr args)) + (cond ((string= subcmd "ACK") + (push cap rcirc-acked-capabilities) + (setq rcirc-requested-capabilities + (delete cap rcirc-requested-capabilities))) + ((string= subcmd "NAK") + (setq rcirc-requested-capabilities + (delete cap rcirc-requested-capabilities)))))) + (when (null rcirc-requested-capabilities) + ;; All requested capabilities have been responded to + (rcirc-send-string process "CAP" "END")))) + (defgroup rcirc-faces nil "Faces for rcirc." commit 4ff1f66b12359fbb91821da5b87580b98ac49af3 Author: Philip Kaludercic Date: Wed Jun 9 18:16:47 2021 +0200 Replace defun-rcirc-command with rcirc-define-command * rcirc.el (defun-rcirc-command): Remove old macro (rcirc-define-command): Create new macro diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index d463a14548..1b3601771b 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2242,54 +2242,66 @@ prefix with another element in PAIRS." ;; the current buffer/channel/user, and ARGS, which is a string ;; containing the text following the /cmd. -(defmacro defun-rcirc-command (command argument - docstring interactive-form - &rest body) - "Define COMMAND that operates on ARGUMENT. -This macro internally defines an interactive function, prefixing -COMMAND with `rcirc-cmd-'. DOCSTRING, INTERACTIVE-FORM and BODY -are passed directly to `defun'." - `(progn - (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command))) - (defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) - (,@argument &optional process target) - ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" - "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - ,interactive-form - (let ((process (or process (rcirc-buffer-process))) - (target (or target rcirc-target))) - (ignore target) ; mark `target' variable as ignorable - ,@body)))) - -(defun-rcirc-command msg (message) - "Send private MESSAGE to TARGET." - (interactive "i") - (if (null message) - (progn - (setq target (completing-read "Message nick: " +(defmacro rcirc-define-command (command arguments &rest body) + "Define a new client COMMAND in BODY that takes ARGUMENTS. +Just like `defun', a string at the beginning of BODY is +interpreted as the documentation string. Following that, an +interactive form can specified." + (declare (debug (symbolp (&rest symbolp) def-body)) + (indent defun)) + (cl-check-type command symbol) + (cl-check-type arguments list) + (let ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command))) ) + (regexp (with-temp-buffer + (insert "\\`") + (when arguments + (dotimes (_ (1- (length arguments))) + (insert "\\(.+?\\)[[:space:]]*")) + (insert "\\(.*\\)")) + (insert "[[:space:]]*\\'") + (buffer-string))) + (argument (gensym)) + documentation + interactive-spec) + (when (stringp (car body)) + (setq documentation (pop body))) + (when (eq (car-safe (car-safe body)) 'interactive) + (setq interactive-spec (cdr (pop body)))) + `(progn + (defun ,fn-name (,argument &optional process target) + ,(concat documentation + "\n\nNote: If PROCESS or TARGET are nil, the values given" + "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") + (interactive ,@interactive-spec) + (unless (if (listp ,argument) + (= (length ,argument) ,(length arguments)) + (string-match ,regexp ,argument)) + (user-error "Malformed input: %S" ',arguments)) + (let ((process (or process (rcirc-buffer-process))) + (target (or target rcirc-target))) + (ignore target process) + (let (,@(cl-loop + for i from 0 for arg in arguments + collect `(,arg (if (listp ,argument) + (nth ,i ,argument) + (match-string ,(1+ i) ,argument))))) + ,@body))) + (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))))) + +(define-obsolete-function-alias + 'defun-rcirc-command + 'rcirc-define-command + "28.1") + +(rcirc-define-command msg (chan-or-nick message) + "Send MESSAGE to CHAN-OR-NICK." + (interactive (list (completing-read "Message nick: " (with-rcirc-server-buffer - rcirc-nick-table))) - (when (> (length target) 0) - (setq message (read-string (format "Message %s: " target))) - (when (> (length message) 0) - (rcirc-send-message process target message)))) - (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message)) - (message "Not enough args, or something.") - (setq target (match-string 1 message) - message (match-string 2 message)) - (rcirc-send-message process target message)))) - -(defun-rcirc-command query (nick) - "Open a private chat buffer to NICK." - (interactive (list (completing-read "Query nick: " - (with-rcirc-server-buffer rcirc-nick-table)))) - (let ((existing-buffer (rcirc-get-buffer process nick))) - (switch-to-buffer (or existing-buffer - (rcirc-get-buffer-create process nick))) - (when (not existing-buffer) - (rcirc-cmd-whois nick)))) - -(defun-rcirc-command join (channels) + rcirc-nick-table)) + (read-string "Message: "))) + (rcirc-send-message process chan-or-nick message)) + +(rcirc-define-command join (channels) "Join CHANNELS. CHANNELS is a comma- or space-separated string of channel names." (interactive "sJoin channels: ") @@ -2303,17 +2315,15 @@ CHANNELS is a comma- or space-separated string of channel names." (dolist (b buffers) ;; order the new channel buffers in the buffer list (switch-to-buffer b))))) -(defun-rcirc-command invite (nick-channel) +(rcirc-define-command invite (nick channel) "Invite NICK to CHANNEL." (interactive (list - (concat - (completing-read "Invite nick: " - (with-rcirc-server-buffer rcirc-nick-table)) - " " - (read-string "Channel: ")))) - (rcirc-send-string process "INVITE" nick-channel)) - -(defun-rcirc-command part (channel) + (completing-read "Invite nick: " + (with-rcirc-server-buffer rcirc-nick-table)) + (read-string "Channel: "))) + (rcirc-send-string process "INVITE" nick channel)) + +(rcirc-define-command part (channel) "Part CHANNEL. CHANNEL should be a string of the form \"#CHANNEL-NAME REASON\". If omitted, CHANNEL-NAME defaults to TARGET, and REASON defaults @@ -2329,14 +2339,14 @@ to `rcirc-default-part-reason'." target))) (rcirc-send-string process "PART" channel : msg))) -(defun-rcirc-command quit (reason) +(rcirc-define-command quit (reason) "Send a quit message to server with REASON." (interactive "sQuit reason: ") (rcirc-send-string process "QUIT" : (if (not (zerop (length reason))) reason rcirc-default-quit-reason))) -(defun-rcirc-command reconnect (_) +(rcirc-define-command reconnect (_) "Reconnect to current server." (interactive "i") (with-rcirc-server-buffer @@ -2349,73 +2359,67 @@ to `rcirc-default-part-reason'." (mapcar #'car rcirc-buffer-alist))) (apply #'rcirc-connect conn-info)))))) -(defun-rcirc-command nick (nick) +(rcirc-define-command nick (nick) "Change nick to NICK." - (interactive "i") - (when (null nick) - (setq nick (read-string "New nick: " (rcirc-nick process)))) + (interactive (list (read-string "New nick: "))) (rcirc-send-string process "NICK" nick)) -(defun-rcirc-command names (channel) +(rcirc-define-command names (channel) "Display list of names in CHANNEL or in current channel if CHANNEL is nil. If called interactively, prompt for a channel when prefix arg is supplied." - (interactive "P") - (if (called-interactively-p 'interactive) - (if channel - (setq channel (read-string "List names in channel: " target)))) + (interactive (list (and current-prefix-arg + (read-string "List names in channel: ")))) (let ((channel (if (> (length channel) 0) channel target))) (rcirc-send-string process "NAMES" channel))) -(defun-rcirc-command topic (topic) +(rcirc-define-command topic (topic) "List TOPIC for the TARGET channel. With a prefix arg, prompt for new topic." - (interactive "P") - (if (and (called-interactively-p 'interactive) topic) - (setq topic (read-string "New Topic: " rcirc-topic))) + (interactive (list (and current-prefix-arg + (read-string "List names in channel: ")))) (if (> (length topic) 0) (rcirc-send-string process "TOPIC" : topic) (rcirc-send-string process "TOPIC"))) -(defun-rcirc-command whois (nick) +(rcirc-define-command whois (nick) "Request information from server about NICK." - (interactive (list - (completing-read "Whois: " - (with-rcirc-server-buffer rcirc-nick-table)))) + (interactive (list (completing-read + "Whois: " + (with-rcirc-server-buffer rcirc-nick-table)))) (rcirc-send-string process "WHOIS" nick)) -(defun-rcirc-command mode (args) - "Set mode with ARGS." - (interactive (list (concat (read-string "Mode nick or channel: ") - " " (read-string "Mode: ")))) - (rcirc-send-string process "MODE" args)) +(rcirc-define-command mode (nick-or-chan mode) + "Set NICK-OR-CHAN mode to MODE." + (interactive (list (read-string "Mode nick or channel: ") + (read-string "Mode: "))) + (rcirc-send-string process "MODE" nick-or-chan mode)) -(defun-rcirc-command list (channels) +(rcirc-define-command list (channels) "Request information on CHANNELS from server." (interactive "sList Channels: ") (rcirc-send-string process "LIST" channels)) -(defun-rcirc-command oper (args) +(rcirc-define-command oper (args) "Send operator command to server." (interactive "sOper args: ") (rcirc-send-string process "OPER" args)) -(defun-rcirc-command quote (message) +(rcirc-define-command quote (message) "Send MESSAGE literally to server." (interactive "sServer message: ") (rcirc-send-string process message)) -(defun-rcirc-command kick (arg) +(rcirc-define-command kick (nick reason) "Kick NICK from current channel." (interactive (list - (concat (completing-read "Kick nick: " - (rcirc-channel-nicks - (rcirc-buffer-process) - rcirc-target)) - (read-from-minibuffer "Kick reason: ")))) - (let ((args (split-string arg))) - (rcirc-send-string process "KICK" target (car args) : (cdr args)))) + (completing-read "Kick nick: " + (rcirc-channel-nicks + (rcirc-buffer-process) + rcirc-target)) + (read-from-minibuffer "Kick reason: "))) + (rcirc-send-string process "KICK" target nick : reason)) (defun rcirc-cmd-ctcp (args &optional process _target) "Handle ARGS as a CTCP command. @@ -2451,7 +2455,7 @@ PROCESS is the process object for the current connection." set) -(defun-rcirc-command ignore (nick) +(rcirc-define-command ignore (nick) "Manage the ignore list. Ignore NICK, unignore NICK if already ignored, or list ignored nicks when no NICK is given. When listing ignored nicks, the @@ -2468,7 +2472,7 @@ ones added to the list automatically are marked with an asterisk." "*" ""))) rcirc-ignore-list " "))) -(defun-rcirc-command bright (nick) +(rcirc-define-command bright (nick) "Manage the bright nick list." (interactive "sToggle emphasis of nick: ") (setq rcirc-bright-nicks @@ -2477,7 +2481,7 @@ ones added to the list automatically are marked with an asterisk." (rcirc-print process nil "BRIGHT" target (mapconcat 'identity rcirc-bright-nicks " "))) -(defun-rcirc-command dim (nick) +(rcirc-define-command dim (nick) "Manage the dim nick list." (interactive "sToggle deemphasis of nick: ") (setq rcirc-dim-nicks @@ -2486,7 +2490,7 @@ ones added to the list automatically are marked with an asterisk." (rcirc-print process nil "DIM" target (mapconcat 'identity rcirc-dim-nicks " "))) -(defun-rcirc-command keyword (keyword) +(rcirc-define-command keyword (keyword) "Manage the keyword list. Mark KEYWORD, unmark KEYWORD if already marked, or list marked keywords when no KEYWORD is given." commit 0b367ec39f41825f3eb2ce6acc4d2dd764ecc898 Author: Philip Kaludercic Date: Wed Jun 9 18:05:35 2021 +0200 Remove custom rcirc-completion implementation * rcirc.el (rcirc-completion-at-point): Improve completion suggestions (rcirc-completions): Remove variable (rcirc-completion-start): Remove variable (rcirc-complete): Remove function (rcirc-mode-map): Bind TAB to completion-at-point (rcirc-mode): Use cycling for completion diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index b919e03dce..d463a14548 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1023,50 +1023,30 @@ The list is updated automatically by `defun-rcirc-command'.") (if (re-search-backward "[[:space:]@]" rcirc-prompt-end-marker t) (1+ (point)) rcirc-prompt-end-marker))) - (table (if (and (= beg rcirc-prompt-end-marker) - (eq (char-after beg) ?/)) - (delete-dups - (nconc (sort (copy-sequence rcirc-client-commands) - 'string-lessp) - (sort (copy-sequence rcirc-server-commands) - 'string-lessp))) - (rcirc-channel-nicks (rcirc-buffer-process) - rcirc-target)))) + (table (cond + ;; No completion before the prompt + ((< beg rcirc-prompt-end-marker) nil) + ;; Only complete nicks mid-message + ((> beg rcirc-prompt-end-marker) + (rcirc-channel-nicks (rcirc-buffer-process) + rcirc-target)) + ;; Complete commands at the beginning of the + ;; message, when the first character is a dash + ((eq (char-after beg) ?/) + (mapcar + (lambda (cmd) (concat cmd " ")) + (nconc (sort (copy-sequence rcirc-client-commands) + 'string-lessp) + (sort (copy-sequence rcirc-server-commands) + 'string-lessp)))) + ;; Complete usernames right after the prompt by + ;; appending a colon after the name + ((mapcar + (lambda (str) (concat str ": ")) + (rcirc-channel-nicks (rcirc-buffer-process) + rcirc-target)))))) (list beg (point) table)))) -(defvar rcirc-completions nil - "List of possible completions to cycle through.") - -(defvar rcirc-completion-start nil - "Point indicating where completion starts.") - -(defun rcirc-complete () - "Cycle through completions from list of nicks in channel or IRC commands. -IRC command completion is performed only if `/' is the first input char." - (interactive) - (unless (rcirc-looking-at-input) - (error "Point not located after rcirc prompt")) - (if (eq last-command this-command) - (setq rcirc-completions - (append (cdr rcirc-completions) (list (car rcirc-completions)))) - (let ((completion-ignore-case t) - (table (rcirc-completion-at-point))) - (setq rcirc-completion-start (car table)) - (setq rcirc-completions - (and rcirc-completion-start - (all-completions (buffer-substring rcirc-completion-start - (cadr table)) - (nth 2 table)))))) - (let ((completion (car rcirc-completions))) - (when completion - (delete-region rcirc-completion-start (point)) - (insert - (cond - ((= (aref completion 0) ?/) (concat completion " ")) - ((= rcirc-completion-start rcirc-prompt-end-marker) - (format rcirc-nick-completion-format completion)) - (t completion)))))) - (defun set-rcirc-decode-coding-system (coding-system) "Set the decode CODING-SYSTEM used in this channel." (interactive "zCoding system for incoming messages: ") @@ -1082,7 +1062,7 @@ IRC command completion is performed only if `/' is the first input char." (define-key map (kbd "RET") 'rcirc-send-input) (define-key map (kbd "M-p") 'rcirc-insert-prev-input) (define-key map (kbd "M-n") 'rcirc-insert-next-input) - (define-key map (kbd "TAB") 'rcirc-complete) + (define-key map (kbd "TAB") 'completion-at-point) (define-key map (kbd "C-c C-b") 'rcirc-browse-url) (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline) (define-key map (kbd "C-c C-j") 'rcirc-cmd-join) @@ -1195,6 +1175,7 @@ This number is independent of the number of lines in the buffer.") (add-hook 'completion-at-point-functions 'rcirc-completion-at-point nil 'local) + (setq-local completion-cycle-threshold t) (run-mode-hooks 'rcirc-mode-hook)) commit 8ea5766050a2bc27ad1166daca3ab2b4707d5728 Author: Philip Kaludercic Date: Wed Jun 9 16:17:48 2021 +0200 Recognize quoted commands in rcirc-process-input-line * rcirc.el (rcirc-process-input-line): Check for quoted commands (rcirc-process-command): Don't check for quoted commands diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index bc7d89c78f..b919e03dce 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1380,7 +1380,7 @@ The argument JUSTIFY is passed on to `fill-region'." (defun rcirc-process-input-line (line) "Process LINE as a message or a command." - (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line) + (if (string-match "^/\\([^/ ][^ ]*\\) ?\\(.*\\)$" line) (rcirc-process-command (match-string 1 line) (match-string 2 line) line) @@ -1398,25 +1398,20 @@ The argument JUSTIFY is passed on to `fill-region'." "Process COMMAND with arguments ARGS. LINE is the raw input, from which COMMAND and ARGS was extracted." - (if (eq (aref command 0) ?/) - ;; "//text" will send "/text" as a message - (rcirc-process-message (substring line 1)) - (let ((fun (intern-soft (concat "rcirc-cmd-" command))) - (process (rcirc-buffer-process))) - (newline) - (with-current-buffer (current-buffer) - (delete-region rcirc-prompt-end-marker (point)) - (if (string= command "me") - (rcirc-print process (rcirc-buffer-nick) - "ACTION" rcirc-target args) + (let ((fun (intern-soft (concat "rcirc-cmd-" command))) + (process (rcirc-buffer-process))) + (newline) + (with-current-buffer (current-buffer) + (delete-region rcirc-prompt-end-marker (point)) + (if (string= command "me") (rcirc-print process (rcirc-buffer-nick) - "COMMAND" rcirc-target line)) - (set-marker rcirc-prompt-end-marker (point)) - (if (fboundp fun) - (funcall fun args process rcirc-target) - (rcirc-send-string process - (concat command " :" args))))))) - + "ACTION" rcirc-target args) + (rcirc-print process (rcirc-buffer-nick) + "COMMAND" rcirc-target line)) + (set-marker rcirc-prompt-end-marker (point)) + (if (fboundp fun) + (funcall fun args process rcirc-target) + (rcirc-send-string process command : args))))) (defvar-local rcirc-parent-buffer nil "Message buffer that requested a multiline buffer.") commit e6c99a761d1603ef9f065292a853a32d6a0ffd34 Author: Philip Kaludercic Date: Wed Jun 9 16:14:29 2021 +0200 Integrate formatting into rcirc-send-string * rcirc.el (rcirc-connect): Use new syntax (rcirc-send-string): Allow for more arguments (rcirc-send-privmsg): Use new syntax (rcirc-send-ctcp): Use new syntax (rcirc-send-message): Use new syntax (rcirc-clean-up-buffer): Use new syntax (join): Use new syntax (invite): Use new syntax (part): Use new syntax (quit): Use new syntax (nick): Use new syntax (names): Use new syntax (topic): Use new syntax (whois): Use new syntax (mode): Use new syntax (list): Use new syntax (oper): Use new syntax (kick): Use new syntax (rcirc-handler-PING): Use new syntax (rcirc-handler-ctcp-VERSION): Use new syntax (rcirc-handler-ctcp-ACTION): Use new syntax (rcirc-handler-ctcp-TIME): Use new syntax diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 5a21bd81a8..bc7d89c78f 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -629,10 +629,9 @@ that are joined after authentication." ;; identify (unless (zerop (length password)) - (rcirc-send-string process (concat "PASS " password))) - (rcirc-send-string process (concat "NICK " nick)) - (rcirc-send-string process (concat "USER " user-name - " 0 * :" full-name)) + (rcirc-send-string process "PASS" password)) + (rcirc-send-string process "NICK" nick) + (rcirc-send-string process "USER" user-name "0" "*" : full-name) ;; setup ping timer if necessary (unless rcirc-keepalive-timer @@ -875,9 +874,21 @@ used as the message body." "Check if PROCESS is open or running." (memq (process-status process) '(run open))) -(defun rcirc-send-string (process string) - "Send PROCESS a STRING plus a newline." - (let ((string (concat (encode-coding-string string rcirc-encode-coding-system) +(defun rcirc-send-string (process &rest parts) + "Send PROCESS a PARTS plus a newline. +PARTS may contain a `:' symbol, to designate that the next string +is the message, that should be prefixed by a colon. If the last +element in PARTS is a list, append it to PARTS." + (let ((last (car (last parts)))) + (when (listp last) + (setf parts (append (butlast parts) last)))) + (when-let (message (memq : parts)) + (cl-check-type (cadr message) string) + (setf (cadr message) (concat ":" (cadr message)) + parts (remq : parts))) + (let ((string (concat (encode-coding-string + (mapconcat #'identity parts " ") + rcirc-encode-coding-system) "\n"))) (unless (rcirc--connection-open-p process) (error "Network connection to %s is not open" @@ -888,13 +899,15 @@ used as the message body." (defun rcirc-send-privmsg (process target string) "Send TARGET the message in STRING via PROCESS." (cl-check-type target string) - (rcirc-send-string process (format "PRIVMSG %s :%s" target string))) + (rcirc-send-string process "PRIVMSG" target : string)) + +(defun rcirc-ctcp-wrap (&rest args) + "Join ARGS into a string wrapped by ASCII 1 charterers." + (concat "\C-a" (string-join (delq nil args) " ") "\C-a")) (defun rcirc-send-ctcp (process target request &optional args) "Send TARGET a REQUEST via PROCESS." - (let ((args (if args (concat " " args) ""))) - (rcirc-send-privmsg process target - (format "\C-a%s%s\C-a" request args)))) + (rcirc-send-privmsg process target (rcirc-ctcp-wrap request args))) (defun rcirc-buffer-process (&optional buffer) "Return the process associated with channel BUFFER. @@ -953,7 +966,7 @@ If SILENT is non-nil, do not print the message in any irc buffer." (let ((response (if noticep "NOTICE" "PRIVMSG"))) (rcirc-get-buffer-create process target) (dolist (msg (rcirc-split-message message)) - (rcirc-send-string process (concat response " " target " :" msg)) + (rcirc-send-string process response target : msg) (unless silent (rcirc-print process (rcirc-nick process) response target msg))))) @@ -1278,7 +1291,7 @@ with it." (rcirc-update-short-buffer-names) (if (rcirc-channel-p rcirc-target) (rcirc-send-string (rcirc-buffer-process) - (concat "PART " rcirc-target " :" reason)) + "PART" rcirc-target : reason) (when rcirc-target (rcirc-remove-nick-channel (rcirc-buffer-process) (rcirc-buffer-nick) @@ -2309,7 +2322,7 @@ CHANNELS is a comma- or space-separated string of channel names." (rcirc-get-buffer-create process ch)) split-channels)) (channels (mapconcat 'identity split-channels ","))) - (rcirc-send-string process (concat "JOIN " channels)) + (rcirc-send-string process "JOIN" channels) (when (not (eq (selected-window) (minibuffer-window))) (dolist (b buffers) ;; order the new channel buffers in the buffer list (switch-to-buffer b))))) @@ -2322,7 +2335,7 @@ CHANNELS is a comma- or space-separated string of channel names." (with-rcirc-server-buffer rcirc-nick-table)) " " (read-string "Channel: ")))) - (rcirc-send-string process (concat "INVITE " nick-channel))) + (rcirc-send-string process "INVITE" nick-channel)) (defun-rcirc-command part (channel) "Part CHANNEL. @@ -2338,15 +2351,14 @@ to `rcirc-default-part-reason'." (setq channel (if (match-beginning 1) (match-string 1 channel) target))) - (rcirc-send-string process (concat "PART " channel " :" msg)))) + (rcirc-send-string process "PART" channel : msg))) (defun-rcirc-command quit (reason) "Send a quit message to server with REASON." (interactive "sQuit reason: ") - (rcirc-send-string process (concat "QUIT :" - (if (not (zerop (length reason))) + (rcirc-send-string process "QUIT" : (if (not (zerop (length reason))) reason - rcirc-default-quit-reason)))) + rcirc-default-quit-reason))) (defun-rcirc-command reconnect (_) "Reconnect to current server." @@ -2366,7 +2378,7 @@ to `rcirc-default-part-reason'." (interactive "i") (when (null nick) (setq nick (read-string "New nick: " (rcirc-nick process)))) - (rcirc-send-string process (concat "NICK " nick))) + (rcirc-send-string process "NICK" nick)) (defun-rcirc-command names (channel) "Display list of names in CHANNEL or in current channel if CHANNEL is nil. @@ -2378,7 +2390,7 @@ If called interactively, prompt for a channel when prefix arg is supplied." (let ((channel (if (> (length channel) 0) channel target))) - (rcirc-send-string process (concat "NAMES " channel)))) + (rcirc-send-string process "NAMES" channel))) (defun-rcirc-command topic (topic) "List TOPIC for the TARGET channel. @@ -2386,32 +2398,32 @@ With a prefix arg, prompt for new topic." (interactive "P") (if (and (called-interactively-p 'interactive) topic) (setq topic (read-string "New Topic: " rcirc-topic))) - (rcirc-send-string process (concat "TOPIC " target - (when (> (length topic) 0) - (concat " :" topic))))) + (if (> (length topic) 0) + (rcirc-send-string process "TOPIC" : topic) + (rcirc-send-string process "TOPIC"))) (defun-rcirc-command whois (nick) "Request information from server about NICK." (interactive (list (completing-read "Whois: " (with-rcirc-server-buffer rcirc-nick-table)))) - (rcirc-send-string process (concat "WHOIS " nick))) + (rcirc-send-string process "WHOIS" nick)) (defun-rcirc-command mode (args) "Set mode with ARGS." (interactive (list (concat (read-string "Mode nick or channel: ") " " (read-string "Mode: ")))) - (rcirc-send-string process (concat "MODE " args))) + (rcirc-send-string process "MODE" args)) (defun-rcirc-command list (channels) "Request information on CHANNELS from server." (interactive "sList Channels: ") - (rcirc-send-string process (concat "LIST " channels))) + (rcirc-send-string process "LIST" channels)) (defun-rcirc-command oper (args) "Send operator command to server." (interactive "sOper args: ") - (rcirc-send-string process (concat "OPER " args))) + (rcirc-send-string process "OPER" args)) (defun-rcirc-command quote (message) "Send MESSAGE literally to server." @@ -2426,10 +2438,8 @@ With a prefix arg, prompt for new topic." (rcirc-buffer-process) rcirc-target)) (read-from-minibuffer "Kick reason: ")))) - (let* ((arglist (split-string arg)) - (argstring (concat (car arglist) " :" - (mapconcat 'identity (cdr arglist) " ")))) - (rcirc-send-string process (concat "KICK " target " " argstring)))) + (let ((args (split-string arg))) + (rcirc-send-string process "KICK" target (car args) : (cdr args)))) (defun rcirc-cmd-ctcp (args &optional process _target) "Handle ARGS as a CTCP command. @@ -2943,8 +2953,7 @@ PROCESS is the process object for the current connection." ARGS should have the form (MESSAGE). MESSAGE is relayed back to the server. PROCESS is the process object for the current connection." - (rcirc-send-string process (concat "PONG :" (car args)))) - + (rcirc-send-string process "PONG" : (car args))) (defun rcirc-handler-PONG (_process _sender _args _text) "Ignore all incoming PONG messages.") @@ -3187,10 +3196,8 @@ current connection." (defun rcirc-handler-ctcp-VERSION (process _target sender _message) "Handle a CTCP VERSION message from SENDER. PROCESS is the process object for the current connection." - (rcirc-send-string process - (concat "NOTICE " sender - " :\C-aVERSION " rcirc-id-string - "\C-a"))) + (rcirc-send-string process "NOTICE" sender : + (rcirc-ctcp-wrap "VERSION" rcirc-id-string))) (defun rcirc-handler-ctcp-ACTION (process target sender message) "Handle a CTCP ACTION MESSAGE from SENDER to TARGET. @@ -3200,9 +3207,8 @@ PROCESS is the process object for the current connection." (defun rcirc-handler-ctcp-TIME (process _target sender _message) "Respond to CTCP TIME message from SENDER. PROCESS is the process object for the current connection." - (rcirc-send-string process - (concat "NOTICE " sender - " :\C-aTIME " (current-time-string) "\C-a"))) + (rcirc-send-string process "NOTICE" sender : + (rcirc-ctcp-wrap "TIME" (current-time-string)))) (defun rcirc-handler-CTCP-response (process _target sender message) "Handle CTCP response MESSAGE from SENDER. commit fb158754c466e7118f5e3ac158fec4aedb9c76b3 Author: Philip Kaludercic Date: Fri Jun 4 14:14:35 2021 +0200 Fix checkdoc complaints and related issues diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 67dcf3e4ea..5a21bd81a8 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; Internet Relay Chat (IRC) is a form of instant communication over -;; the Internet. It is mainly designed for group (many-to-many) +;; the Internet. It is mainly designed for group (many-to-many) ;; communication in discussion forums called channels, but also allows ;; one-to-one communication. @@ -46,6 +46,7 @@ (require 'time-date) (require 'auth-source) (eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'rx)) (defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version)) @@ -109,8 +110,9 @@ for connections using SSL/TLS. `:server-alias' -VALUE must be a string that will be used instead of the server name for -display purposes. If absent, the real server name will be displayed instead." +VALUE must be a string that will be used instead of the server +name for display purposes. If absent, the real server name will +be displayed instead." :type '(alist :key-type string :value-type (plist :options ((:nick string) @@ -181,17 +183,18 @@ If nil, no maximum is applied." (integer :tag "Number of characters"))) (defvar-local rcirc-ignore-buffer-activity-flag nil - "If non-nil, ignore activity in this buffer.") + "Non-nil means ignore activity in this buffer.") (defvar-local rcirc-low-priority-flag nil - "If non-nil, activity in this buffer is considered low priority.") + "Non-nil means activity in this buffer is considered low priority.") (defcustom rcirc-omit-responses '("JOIN" "PART" "QUIT" "NICK") "Responses which will be hidden when `rcirc-omit-mode' is enabled." :type '(repeat string)) -(defvar rcirc-prompt-start-marker nil) +(defvar rcirc-prompt-start-marker nil + "Marker indicating the beginning of the message prompt.") (define-minor-mode rcirc-omit-mode "Toggle the hiding of \"uninteresting\" lines. @@ -230,8 +233,7 @@ number. If zero or nil, no truncating is done." (integer :tag "Number of lines"))) (defcustom rcirc-scroll-show-maximum-output t - "If non-nil, scroll buffer to keep the point at the bottom of -the window." + "Non-nil means scroll to keep the point at the bottom of the window." :type 'boolean) (defcustom rcirc-authinfo nil @@ -292,8 +294,9 @@ The following replacements are made: %s is the server. %t is the buffer target, a channel or a user. -Setting this alone will not affect the prompt; -use either M-x customize or also call `rcirc-update-prompt'." +Setting this alone will not affect the prompt; use either +\\[execute-extended-command] customize or also call +`rcirc-update-prompt'." :type 'string :set #'rcirc-set-changed :initialize 'custom-initialize-default) @@ -387,11 +390,14 @@ will be killed." :version "24.3" :type 'boolean) -(defvar rcirc-nick nil) +(defvar rcirc-nick nil + "The nickname used for the current connection.") -(defvar rcirc-prompt-end-marker nil) +(defvar rcirc-prompt-end-marker nil + "Marker indicating the end of the message prompt.") -(defvar rcirc-nick-table nil) +(defvar rcirc-nick-table nil + "Hash table mapping nicks to channels.") (defvar rcirc-recent-quit-alist nil "Alist of nicks that have recently quit or parted the channel.") @@ -404,8 +410,8 @@ will be killed." table) "Syntax table which includes all nick characters as word constituents.") -;; each process has an alist of (target . buffer) pairs -(defvar rcirc-buffer-alist nil) +(defvar rcirc-buffer-alist nil + "Alist of (TARGET . BUFFER) pairs.") (defvar rcirc-activity nil "List of buffers with unviewed activity.") @@ -431,7 +437,8 @@ will be killed." "Kill connection after this many seconds if there is no activity.") -(defvar rcirc-startup-channels nil) +(defvar rcirc-startup-channels nil + "List of channel names to join after authenticating.") (defvar rcirc-server-name-history nil "History variable for \\[rcirc] call.") @@ -538,23 +545,43 @@ If ARG is non-nil, instead prompt for connection parameters." (defalias 'irc 'rcirc) -(defvar rcirc-process-output nil) -(defvar rcirc-topic nil) -(defvar rcirc-keepalive-timer nil) -(defvar rcirc-last-server-message-time nil) -(defvar rcirc-server nil) ; server provided by server -(defvar rcirc-server-name nil) ; server name given by 001 response -(defvar rcirc-timeout-timer nil) -(defvar rcirc-user-authenticated nil) -(defvar rcirc-user-disconnect nil) -(defvar rcirc-connecting nil) -(defvar rcirc-connection-info nil) -(defvar rcirc-process nil) +(defvar rcirc-process-output nil + "Partial message response.") +(defvar rcirc-topic nil + "Topic of the current channel.") +(defvar rcirc-keepalive-timer nil + "Timer for sending KEEPALIVE message.") +(defvar rcirc-last-server-message-time nil + "Timestamp for the last server response.") +(defvar rcirc-server nil + "Server provided by server.") +(defvar rcirc-server-name nil + "Server name given by 001 response.") +(defvar rcirc-timeout-timer nil + "Timer for determining a network timeout.") +(defvar rcirc-user-authenticated nil + "Flag indicating if the user is authenticated.") +(defvar rcirc-user-disconnect nil + "Flag indicating if the connection was broken.") +(defvar rcirc-connecting nil + "Flag indicating if the connection is being established.") +(defvar rcirc-connection-info nil + "Information about the current connection. +If defined, it is a list of this form (SERVER PORT NICK USER-NAME +FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS). +See `rcirc-connect' for more details on these variables.") +(defvar rcirc-process nil + "Network process for the current connection.") ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption server-alias) + "Connect to SERVER. +The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD, +ENCRYPTION, SERVER-ALIAS are interpreted as in +`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels +that are joined after authentication." (save-excursion (message "Connecting to %s..." (or server-alias server)) (let* ((inhibit-eol-conversion) @@ -618,11 +645,13 @@ If ARG is non-nil, instead prompt for connection parameters." process))) (defmacro with-rcirc-process-buffer (process &rest body) + "Evaluate BODY in the buffer of PROCESS." (declare (indent 1) (debug t)) `(with-current-buffer (process-buffer ,process) ,@body)) (defmacro with-rcirc-server-buffer (&rest body) + "Evaluate BODY in the server buffer of the current channel." (declare (indent 0) (debug t)) `(with-current-buffer rcirc-server-buffer ,@body)) @@ -658,14 +687,18 @@ last ping." (setq rcirc-keepalive-timer nil))) (defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message) + "Uptime header in PROCESS buffer. +MESSAGE should contain a timestamp, indicating when the KEEPALIVE +message was generated." (with-rcirc-process-buffer process (setq header-line-format (format "%f" (float-time (time-since (string-to-number message))))))) -(defvar rcirc-debug-buffer "*rcirc debug*") +(defvar rcirc-debug-buffer "*rcirc debug*" + "Buffer name for debugging messages.") (defvar rcirc-debug-flag nil - "If non-nil, write information to `rcirc-debug-buffer'.") + "Non-nil means write information to `rcirc-debug-buffer'.") (defun rcirc-debug (process text) "Add an entry to the debug log including PROCESS and TEXT. Debug text is appended to `rcirc-debug-buffer' if `rcirc-debug-flag' @@ -727,6 +760,8 @@ When 0, do not auto-reconnect." (run-hook-with-args 'rcirc-sentinel-functions process sentinel)))) (defun rcirc-disconnect-buffer (&optional buffer) + "Disconnect BUFFER. +If BUFFER is nil, default to the current buffer." (with-current-buffer (or buffer (current-buffer)) ;; set rcirc-target to nil for each channel so cleanup ;; doesn't happen when we reconnect @@ -764,19 +799,19 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (rcirc-process-server-response process line)))))) (defun rcirc-reschedule-timeout (process) + "Update timeout indicator for PROCESS." (with-rcirc-process-buffer process (when (not rcirc-connecting) (with-rcirc-process-buffer process (when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer)) (setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil - 'rcirc-delete-process + 'delete-process process)))))) -(defun rcirc-delete-process (process) - (delete-process process)) - -(defvar rcirc-trap-errors-flag t) +(defvar rcirc-trap-errors-flag t + "Non-nil means Lisp errors are degraded to error messages.") (defun rcirc-process-server-response (process text) + "Parse TEXT as received from PROCESS." (if rcirc-trap-errors-flag (condition-case err (rcirc-process-server-response-1 process text) @@ -785,13 +820,21 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (format "\"%s\" %s" text err) t))) (rcirc-process-server-response-1 process text))) -(defun rcirc-process-server-response-1 (process text) +(defconst rcirc-process-regexp ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1. We're a ;; bit more accepting than the RFC: We allow any non-space ;; characters in the command name, multiple spaces between ;; arguments, and allow the last argument to omit the leading ":", ;; even if there are less than 15 arguments. - (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\)" text) + (rx line-start + (optional + (group ":" (group (one-or-more (not (any " ")))) " ")) + (group (one-or-more (not (any " "))))) + "Regular expression used for parsing server response.") + +(defun rcirc-process-server-response-1 (process text) + "Parse TEXT as received from PROCESS." + (if (string-match rcirc-process-regexp text) (let* ((user (match-string 2 text)) (sender (rcirc-user-nick user)) (cmd (match-string 3 text)) @@ -819,12 +862,17 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") "Responses that don't trigger activity in the mode-line indicator.") (defun rcirc-handler-generic (process response sender args _text) - "Generic server response handler." + "Generic server response handler. +This handler is called, when no more specific handler could be +found. PROCESS, SENDER and RESPONSE are passed on to +`rcirc-print'. ARGS are concatenated into a single string and +used as the message body." (rcirc-print process sender response nil (mapconcat 'identity (cdr args) " ") (not (member response rcirc-responses-no-activity)))) (defun rcirc--connection-open-p (process) + "Check if PROCESS is open or running." (memq (process-status process) '(run open))) (defun rcirc-send-string (process string) @@ -838,10 +886,12 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (process-send-string process string))) (defun rcirc-send-privmsg (process target string) + "Send TARGET the message in STRING via PROCESS." (cl-check-type target string) (rcirc-send-string process (format "PRIVMSG %s :%s" target string))) (defun rcirc-send-ctcp (process target request &optional args) + "Send TARGET a REQUEST via PROCESS." (let ((args (if args (concat " " args) ""))) (rcirc-send-privmsg process target (format "\C-a%s%s\C-a" request args)))) @@ -907,13 +957,18 @@ If SILENT is non-nil, do not print the message in any irc buffer." (unless silent (rcirc-print process (rcirc-nick process) response target msg))))) -(defvar rcirc-input-ring nil) -(defvar rcirc-input-ring-index 0) +(defvar rcirc-input-ring nil + "Ring object for input.") + +(defvar rcirc-input-ring-index 0 + "Current position in the input ring.") (defun rcirc-prev-input-string (arg) + "Move ARG elements ahead in the input ring." (ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg))) (defun rcirc-insert-prev-input () + "Insert previous element in input ring." (interactive) (when (<= rcirc-prompt-end-marker (point)) (delete-region rcirc-prompt-end-marker (point-max)) @@ -921,6 +976,7 @@ If SILENT is non-nil, do not print the message in any irc buffer." (setq rcirc-input-ring-index (1+ rcirc-input-ring-index)))) (defun rcirc-insert-next-input () + "Insert next element in input ring." (interactive) (when (<= rcirc-prompt-end-marker (point)) (delete-region rcirc-prompt-end-marker (point-max)) @@ -965,8 +1021,11 @@ The list is updated automatically by `defun-rcirc-command'.") rcirc-target)))) (list beg (point) table)))) -(defvar rcirc-completions nil) -(defvar rcirc-completion-start nil) +(defvar rcirc-completions nil + "List of possible completions to cycle through.") + +(defvar rcirc-completion-start nil + "Point indicating where completion starts.") (defun rcirc-complete () "Cycle through completions from list of nicks in channel or IRC commands. @@ -996,12 +1055,12 @@ IRC command completion is performed only if `/' is the first input char." (t completion)))))) (defun set-rcirc-decode-coding-system (coding-system) - "Set the decode coding system used in this channel." + "Set the decode CODING-SYSTEM used in this channel." (interactive "zCoding system for incoming messages: ") (setq-local rcirc-decode-coding-system coding-system)) (defun set-rcirc-encode-coding-system (coding-system) - "Set the encode coding system used in this channel." + "Set the encode CODING-SYSTEM used in this channel." (interactive "zCoding system for outgoing messages: ") (setq-local rcirc-encode-coding-system coding-system)) @@ -1039,7 +1098,8 @@ IRC command completion is performed only if `/' is the first input char." (defvar rcirc-mode-hook nil "Hook run when setting up rcirc buffer.") -(defvar rcirc-last-post-time nil) +(defvar rcirc-last-post-time nil + "Timestamp indicating last user action.") (defvar rcirc-log-alist nil "Alist of lines to log to disk when `rcirc-log-flag' is non-nil. @@ -1050,10 +1110,10 @@ Each element looks like (FILENAME . TEXT).") This number is independent of the number of lines in the buffer.") (defun rcirc-mode (process target) - ;; FIXME: Use define-derived-mode. "Major mode for IRC channel buffers. \\{rcirc-mode-map}" + ;; FIXME: Use define-derived-mode. (kill-all-local-variables) (use-local-map rcirc-mode-map) (setq mode-name "rcirc") @@ -1160,7 +1220,7 @@ If ALL is non-nil, update prompts in all IRC buffers." 'front-sticky t 'rear-nonsticky t)))))))) (defun rcirc-set-changed (option value) - "Set OPTION to VALUE and do updates after a customization change." + "Set OPTION to VALUE and update after a customization change." (set-default option value) (cond ((eq option 'rcirc-prompt) (rcirc-update-prompt 'all)) @@ -1203,10 +1263,11 @@ with it." (kill-buffer (cdr channel)))))) (defun rcirc-change-major-mode-hook () - "Part the channel when changing the major-mode." + "Part the channel when changing the major mode." (rcirc-clean-up-buffer "Changed major mode")) (defun rcirc-clean-up-buffer (reason) + "Clean up current buffer and part with REASON." (let ((buffer (current-buffer))) (rcirc-clear-activity buffer) (when (and (rcirc-buffer-process) @@ -1295,6 +1356,8 @@ Create the buffer if it doesn't exist." (setq rcirc-input-ring-index 0)))))) (defun rcirc-fill-paragraph (&optional justify) + "Implementation for `fill-paragraph-function'. +The argument JUSTIFY is passed on to `fill-region'." (interactive "P") (when (> (point) rcirc-prompt-end-marker) (save-restriction @@ -1303,6 +1366,7 @@ Create the buffer if it doesn't exist." (fill-region (point-min) (point-max) justify))))) (defun rcirc-process-input-line (line) + "Process LINE as a message or a command." (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line) (rcirc-process-command (match-string 1 line) (match-string 2 line) @@ -1310,6 +1374,7 @@ Create the buffer if it doesn't exist." (rcirc-process-message line))) (defun rcirc-process-message (line) + "Process LINE as a message to be sent." (if (not rcirc-target) (message "Not joined (no target)") (delete-region rcirc-prompt-end-marker (point)) @@ -1317,6 +1382,9 @@ Create the buffer if it doesn't exist." (setq rcirc-last-post-time (current-time)))) (defun rcirc-process-command (command args line) + "Process COMMAND with arguments ARGS. +LINE is the raw input, from which COMMAND and ARGS was +extracted." (if (eq (aref command 0) ?/) ;; "//text" will send "/text" as a message (rcirc-process-message (substring line 1)) @@ -1336,9 +1404,14 @@ Create the buffer if it doesn't exist." (rcirc-send-string process (concat command " :" args))))))) -(defvar-local rcirc-parent-buffer nil) + +(defvar-local rcirc-parent-buffer nil + "Message buffer that requested a multiline buffer.") (put 'rcirc-parent-buffer 'permanent-local t) -(defvar rcirc-window-configuration nil) + +(defvar rcirc-window-configuration nil + "Window configuration before creating multiline buffer.") + (defun rcirc-edit-multiline () "Move current edit to a dedicated buffer." (interactive) @@ -1434,9 +1507,10 @@ the of the following escape sequences replaced by the described values: :value-type string)) (defun rcirc-format-response-string (process sender response target text) - "Return a nicely-formatted response string, incorporating TEXT -\(and perhaps other arguments). The specific formatting used -is found by looking up RESPONSE in `rcirc-response-formats'." + "Return a formatted response string from SENDER, incorporating TEXT. +The specific formatting used is found by looking up RESPONSE in +`rcirc-response-formats'. PROCESS is the process object used for +communication." (with-temp-buffer (insert (or (cdr (assoc response rcirc-response-formats)) (cdr (assq t rcirc-response-formats)))) @@ -1490,7 +1564,8 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (buffer-substring (point-min) (point-max)))) (defun rcirc-target-buffer (process sender response target _text) - "Return a buffer to print the server response." + "Return a buffer to print the server response from SENDER. +PROCESS is the process object for the current connection." (cl-assert (not (bufferp target))) (with-rcirc-process-buffer process (cond ((not target) @@ -1506,8 +1581,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'." ((or (rcirc-get-buffer process target) (rcirc-any-buffer process)))))) -(defvar-local rcirc-activity-types nil) (defvar-local rcirc-last-sender nil) +(defvar-local rcirc-activity-types nil + "List of symbols designating kinds of activities in a buffer.") (defcustom rcirc-omit-threshold 100 "Lines since last activity from a nick before `rcirc-omit-responses' are omitted." @@ -1520,14 +1596,16 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (defun rcirc-last-quit-line (process nick target) "Return the line number where NICK left TARGET. -Returns nil if the information is not recorded." +Returns nil if the information is not recorded. +PROCESS is the process object for the current connection." (let ((chanbuf (rcirc-get-buffer process target))) (when chanbuf (cdr (assoc-string nick (with-current-buffer chanbuf rcirc-recent-quit-alist)))))) (defun rcirc-last-line (process nick target) - "Return the line from the last activity from NICK in TARGET." + "Return the line from the last activity from NICK in TARGET. +PROCESS is the process object for the current connection." (let ((line (or (cdr (assoc-string target (gethash nick (with-rcirc-server-buffer rcirc-nick-table)) t)) @@ -1538,7 +1616,8 @@ Returns nil if the information is not recorded." nil))) (defun rcirc-elapsed-lines (process nick target) - "Return the number of lines since activity from NICK in TARGET." + "Return the number of lines since activity from NICK in TARGET. +PROCESS is the process object for the current connection." (let ((last-activity-line (rcirc-last-line process nick target))) (when (and last-activity-line (> last-activity-line 0)) @@ -1550,7 +1629,6 @@ Returns nil if the information is not recorded." rcirc-markup-urls rcirc-markup-keywords rcirc-markup-bright-nicks) - "List of functions used to manipulate text before it is printed. Each function takes two arguments, SENDER, and RESPONSE. The @@ -1560,7 +1638,8 @@ at the beginning of the `rcirc-text' propertized text.") (defun rcirc-print (process sender response target text &optional activity) "Print TEXT in the buffer associated with TARGET. Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, -record activity." +record activity. PROCESS is the process object for the current +connection." (or text (setq text "")) (unless (and (or (member sender rcirc-ignore-list) (member (with-syntax-table rcirc-nick-syntax-table @@ -1689,6 +1768,7 @@ record activity." process sender response target text))))) (defun rcirc-generate-log-filename (process target) + "Return filename for log file based on PROCESS and TARGET." (if target (rcirc-generate-new-buffer-name process target) (process-name process))) @@ -1710,7 +1790,9 @@ guarantee valid filenames for the current OS." :type 'function) (defun rcirc-log (process sender response target text) - "Record line in `rcirc-log', to be later written to disk." + "Record TEXT from SENDER to TARGET to be logged. +The message is logged in `rcirc-log', and is later written to +disk. PROCESS is the process object for the current connection." (let ((filename (funcall rcirc-log-filename-function process target))) (unless (null filename) (let ((cell (assoc-string filename rcirc-log-alist)) @@ -1749,14 +1831,17 @@ log-files with absolute names (see `rcirc-log-filename-function')." rcirc-log-directory))) (defun rcirc-join-channels (process channels) - "Join CHANNELS." + "Join CHANNELS. +PROCESS is the process object for the current connection." (save-window-excursion (dolist (channel channels) (with-rcirc-process-buffer process (rcirc-cmd-join channel process))))) ;;; nick management -(defvar rcirc-nick-prefix-chars "~&@%+") +(defvar rcirc-nick-prefix-chars '(?~ ?& ?@ ?% ?+) + "List of junk characters to strip from nick prefixes.") + (defun rcirc-user-nick (user) "Return the nick from USER. Remove any non-nick junk." (save-match-data @@ -1766,7 +1851,8 @@ log-files with absolute names (see `rcirc-log-filename-function')." user))) (defun rcirc-nick-channels (process nick) - "Return list of channels for NICK." + "Return list of channels for NICK. +PROCESS is the process object for the current connection." (with-rcirc-process-buffer process (mapcar (lambda (x) (car x)) (gethash nick rcirc-nick-table)))) @@ -1776,7 +1862,7 @@ log-files with absolute names (see `rcirc-log-filename-function')." Update the associated linestamp if LINE is non-nil. If the record doesn't exist, and LINE is nil, set the linestamp -to zero." +to zero. PROCESS is the process object for the current connection." (let ((nick (rcirc-user-nick nick))) (with-rcirc-process-buffer process (let* ((chans (gethash nick rcirc-nick-table)) @@ -1788,12 +1874,14 @@ to zero." rcirc-nick-table)))))) (defun rcirc-nick-remove (process nick) - "Remove NICK from table." + "Remove NICK from table. +PROCESS is the process object for the current connection." (with-rcirc-process-buffer process (remhash nick rcirc-nick-table))) (defun rcirc-remove-nick-channel (process nick channel) - "Remove the CHANNEL from list associated with NICK." + "Remove the CHANNEL from list associated with NICK. +PROCESS is the process object for the current connection." (with-rcirc-process-buffer process (let* ((chans (gethash nick rcirc-nick-table)) (newchans @@ -1807,7 +1895,8 @@ to zero." (remhash nick rcirc-nick-table))))) (defun rcirc-channel-nicks (process target) - "Return the list of nicks associated with TARGET sorted by last activity." + "Return the list of nicks associated with TARGET sorted by last activity. +PROCESS is the process object for the current connection." (when target (if (rcirc-channel-p target) (with-rcirc-process-buffer process @@ -1826,8 +1915,9 @@ to zero." (list target)))) (defun rcirc-ignore-update-automatic (nick) - "Remove NICK from `rcirc-ignore-list' -if NICK is also on `rcirc-ignore-list-automatic'." + "Check if NICK is in `rcirc-ignore-list-automatic'. +If so, remove from `rcirc-ignore-list'. PROCESS is the process +object for the current connection." (when (member nick rcirc-ignore-list-automatic) (setq rcirc-ignore-list-automatic (delete nick rcirc-ignore-list-automatic) @@ -1835,7 +1925,7 @@ if NICK is also on `rcirc-ignore-list-automatic'." (delete nick rcirc-ignore-list)))) (defun rcirc-nickname< (s1 s2) - "Return t if IRC nickname S1 is less than S2, and nil otherwise. + "Return non-nil if IRC nickname S1 is less than S2, and nil otherwise. Operator nicknames (@) are considered less than voiced nicknames (+). Any other nicknames are greater than voiced nicknames. The comparison is case-insensitive." @@ -2031,6 +2121,7 @@ activity. Only run if the buffer is not visible and (run-hooks 'rcirc-update-activity-string-hook))) (defun rcirc-activity-string (buffers) + "Generate activity string for all BUFFERS." (mapconcat (lambda (b) (let ((s (substring-no-properties (rcirc-short-buffer-name b)))) (with-current-buffer b @@ -2049,7 +2140,7 @@ activity. Only run if the buffer is not visible and (or rcirc-short-buffer-name (buffer-name)))) (defun rcirc-visible-buffers () - "Return a list of the visible buffers that are in rcirc-mode." + "Return a list of the visible buffers that are in `rcirc-mode'." (let (acc) (walk-windows (lambda (w) (with-current-buffer (window-buffer w) @@ -2057,13 +2148,16 @@ activity. Only run if the buffer is not visible and (push (current-buffer) acc))))) acc)) -(defvar rcirc-visible-buffers nil) +(defvar rcirc-visible-buffers nil + "List of visible IRC buffers.") + (defun rcirc-window-configuration-change () + "Clear activity and overlay arrows, unless minibuffer is active." (unless (minibuffer-window-active-p (minibuffer-window)) (rcirc-window-configuration-change-1))) (defun rcirc-window-configuration-change-1 () - ;; clear activity and overlay arrows + "Clear activity and overlay arrows." (let* ((old-activity rcirc-activity) (hidden-buffers rcirc-visible-buffers)) @@ -2089,6 +2183,7 @@ activity. Only run if the buffer is not visible and ;;; buffer name abbreviation (defun rcirc-update-short-buffer-names () + "Update variable `rcirc-short-buffer-name' for IRC buffers." (let ((bufalist (apply 'append (mapcar (lambda (process) (with-rcirc-process-buffer process @@ -2100,10 +2195,15 @@ activity. Only run if the buffer is not visible and (setq rcirc-short-buffer-name (car i))))))) (defun rcirc-abbreviate (pairs) + "Generate alist of abbreviated buffer names to buffers. +PAIRS is the concatenated value of all `rcirc-buffer-alist' +values, from each process." (apply 'append (mapcar 'rcirc-rebuild-tree (rcirc-make-trees pairs)))) -(defun rcirc-rebuild-tree (tree &optional acc) - (let ((ch (char-to-string (car tree)))) +(defun rcirc-rebuild-tree (tree) + "Merge prefix TREE into alist of unique prefixes to buffers." + (let ((ch (char-to-string (car tree))) + acc) (dolist (x (cdr tree)) (if (listp x) (setq acc (append acc @@ -2115,6 +2215,12 @@ activity. Only run if the buffer is not visible and acc)) (defun rcirc-make-trees (pairs) + "Generate tree prefix tree of buffer names. +PAIRS is a list of (TARGET . BUFFER) entries. The resulting tree +is a list of (CHAR . CHILDREN) cons-cells, where CHAR is the +leading character and CHILDREN is either BUFFER when a unique +prefix could be found or another tree if it shares the same +prefix with another element in PAIRS." (let (alist) (mapc (lambda (pair) (if (consp pair) @@ -2147,9 +2253,13 @@ activity. Only run if the buffer is not visible and ;; the current buffer/channel/user, and ARGS, which is a string ;; containing the text following the /cmd. -(defmacro defun-rcirc-command (command argument docstring interactive-form - &rest body) - "Define a command." +(defmacro defun-rcirc-command (command argument + docstring interactive-form + &rest body) + "Define COMMAND that operates on ARGUMENT. +This macro internally defines an interactive function, prefixing +COMMAND with `rcirc-cmd-'. DOCSTRING, INTERACTIVE-FORM and BODY +are passed directly to `defun'." `(progn (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command))) (defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) @@ -2322,6 +2432,8 @@ With a prefix arg, prompt for new topic." (rcirc-send-string process (concat "KICK " target " " argstring)))) (defun rcirc-cmd-ctcp (args &optional process _target) + "Handle ARGS as a CTCP command. +PROCESS is the process object for the current connection." (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args) (let* ((target (match-string 1 args)) (request (upcase (match-string 2 args))) @@ -2333,14 +2445,18 @@ With a prefix arg, prompt for new topic." "usage: /ctcp NICK REQUEST"))) (defun rcirc-ctcp-sender-PING (process target _request) - "Send a CTCP PING message to TARGET." + "Send a CTCP PING message to TARGET. +PROCESS is the process object for the current connection." (let ((timestamp (format-time-string "%s"))) (rcirc-send-ctcp process target "PING" timestamp))) (defun rcirc-cmd-me (args process target) + "Send an action message ARGS to TARGET. +PROCESS is the process object for the current connection." (when target (rcirc-send-ctcp process target "ACTION" args))) (defun rcirc-add-or-remove (set &rest elements) + "Toggle membership of ELEMENTS in SET." (dolist (elt elements) (if (and elt (not (string= "" elt))) (setq set (if (member-ignore-case elt set) @@ -2348,6 +2464,7 @@ With a prefix arg, prompt for new topic." (cons elt set))))) set) + (defun-rcirc-command ignore (nick) "Manage the ignore list. Ignore NICK, unignore NICK if already ignored, or list ignored @@ -2458,11 +2575,13 @@ If ARG is given, opens the URL in a new browser window." arg))) (defun rcirc-markup-timestamp (_sender _response) + "Insert a timestamp." (goto-char (point-min)) (insert (rcirc-facify (format-time-string rcirc-time-format) 'rcirc-timestamp))) (defun rcirc-markup-attributes (_sender _response) + "Highlight IRC markup, indicated by ASCII control codes." (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) (rcirc-add-face (match-beginning 0) (match-end 0) (cl-case (char-after (match-beginning 1)) @@ -2480,6 +2599,9 @@ If ARG is given, opens the URL in a new browser window." (delete-region (match-beginning 0) (match-end 0)))) (defun rcirc-markup-my-nick (_sender response) + "Highlight the users nick. +If RESPONSE indicates that the nick was mentioned in a message, +highlight the entire line and record the activity." (with-syntax-table rcirc-nick-syntax-table (while (re-search-forward (concat "\\b" (regexp-quote (rcirc-nick @@ -2494,6 +2616,7 @@ If ARG is given, opens the URL in a new browser window." (rcirc-record-activity (current-buffer) 'nick))))) (defun rcirc-markup-urls (_sender _response) + "Highlight and activate URLs." (while (and rcirc-url-regexp ; nil means disable URL catching. (re-search-forward rcirc-url-regexp nil t)) (let* ((start (match-beginning 0)) @@ -2517,6 +2640,10 @@ If ARG is given, opens the URL in a new browser window." (push (cons url start) rcirc-urls))))) (defun rcirc-markup-keywords (sender response) + "Highlight keywords as specified by `rcirc-keywords'. +Keywords are only highlighted in messages (as indicated by +RESPONSE) when they were not written by the user (as indicated by +SENDER)." (when (and (string= response "PRIVMSG") (not (string= sender (rcirc-nick (rcirc-buffer-process))))) (let* ((target (or rcirc-target "")) @@ -2531,6 +2658,9 @@ If ARG is given, opens the URL in a new browser window." (rcirc-record-activity (current-buffer) 'keyword)))))) (defun rcirc-markup-bright-nicks (_sender response) + "Highlight nicks brightly as specified by `rcirc-bright-nicks'. +This highlighting only takes place in name lists (as indicated by +RESPONSE)." (when (and rcirc-bright-nicks (string= response "NAMES")) (with-syntax-table rcirc-nick-syntax-table @@ -2539,6 +2669,8 @@ If ARG is given, opens the URL in a new browser window." 'rcirc-bright-nick))))) (defun rcirc-markup-fill (_sender response) + "Fill messages as configured by `rcirc-fill-column'. +MOTD messages are not filled (as indicated by RESPONSE)." (when (not (string= response "372")) ; /motd (let ((fill-prefix (or rcirc-fill-prefix @@ -2556,8 +2688,11 @@ If ARG is given, opens the URL in a new browser window." ;; server or a user, depending on the command, the ARGS, which is a ;; list of strings, and the TEXT, which is the original server text, ;; verbatim -(defun rcirc-handler-001 (process sender args text) - (rcirc-handler-generic process "001" sender args text) +(defun rcirc-handler-001 (process sender args _text) + "Handle welcome message. +SENDER and ARGS are used to initialize the current connection. +PROCESS is the process object for the current connection." + (rcirc-handler-generic process "001" sender args nil) (with-rcirc-process-buffer process (setq rcirc-connecting nil) (rcirc-reschedule-timeout process) @@ -2581,11 +2716,16 @@ If ARG is given, opens the URL in a new browser window." (rcirc-join-channels process rcirc-startup-channels)))) (defun rcirc-join-channels-post-auth (process) - "Join `rcirc-startup-channels' after authenticating." + "Join `rcirc-startup-channels' after authenticating. +PROCESS is the process object for the current connection." (with-rcirc-process-buffer process (rcirc-join-channels process rcirc-startup-channels))) (defun rcirc-handler-PRIVMSG (process sender args text) + "Handle a (private) message from SENDER. +ARGS should have the form (TARGET MESSAGE). TEXT is the verbatim +message as received from the server. PROCESS is the process +object for the current connection." (rcirc-check-auth-status process sender args text) (let ((target (if (rcirc-channel-p (car args)) (car args) @@ -2599,6 +2739,10 @@ If ARG is given, opens the URL in a new browser window." (rcirc-put-nick-channel process sender target rcirc-current-line)))) (defun rcirc-handler-NOTICE (process sender args text) + "Handle a notice message from SENDER. +ARGS should have the form (TARGET MESSAGE). +TEXT is the verbatim message as received from the server. +PROCESS is the process object for the current connection." (rcirc-check-auth-status process sender args text) (let ((target (car args)) (message (cadr args))) @@ -2608,7 +2752,7 @@ If ARG is given, opens the URL in a new browser window." (rcirc-print process sender "NOTICE" (cond ((rcirc-channel-p target) target) - ;;; -ChanServ- [#gnu] Welcome... + ;; -ChanServ- [#gnu] Welcome... ((string-match "\\[\\(#[^] ]+\\)\\]" message) (match-string 1 message)) (sender @@ -2620,7 +2764,9 @@ If ARG is given, opens the URL in a new browser window." (defun rcirc-check-auth-status (process sender args _text) "Check if the user just authenticated. If authenticated, runs `rcirc-authenticated-hook' with PROCESS as -the only argument." +the only argument. ARGS should have the form (TARGET MESSAGE). +SENDER is used the determine the authentication method. PROCESS +is the process object for the current connection." (with-rcirc-process-buffer process (when (and (not rcirc-user-authenticated) rcirc-authenticate-before-join @@ -2650,9 +2796,17 @@ the only argument." (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t)))))) (defun rcirc-handler-WALLOPS (process sender args _text) + "Handle WALLOPS message from SENDER. +ARGS should have the form (MESSAGE). +PROCESS is the process object for the current +connection." (rcirc-print process sender "WALLOPS" sender (car args) t)) (defun rcirc-handler-JOIN (process sender args _text) + "Handle JOIN message from SENDER. +ARGS should have the form (CHANNEL). +PROCESS is the process object for the current +connection." (let ((channel (car args))) (with-current-buffer (rcirc-get-buffer-create process channel) ;; when recently rejoining, restore the linestamp @@ -2674,6 +2828,8 @@ the only argument." ;; PART and KICK are handled the same way (defun rcirc-handler-PART-or-KICK (process _response channel _sender nick _args) + "Remove NICK from CHANNEL. +PROCESS is the process object for the current connection." (rcirc-ignore-update-automatic nick) (if (not (string= nick (rcirc-nick process))) ;; this is someone else leaving @@ -2691,6 +2847,9 @@ the only argument." (rcirc-disconnect-buffer buffer))))) (defun rcirc-handler-PART (process sender args _text) + "Handle PART message from SENDER. +ARGS should have the form (CHANNEL REASON). +PROCESS is the process object for the current connection." (let* ((channel (car args)) (reason (cadr args)) (message (concat channel " " reason))) @@ -2702,6 +2861,9 @@ the only argument." (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason))) (defun rcirc-handler-KICK (process sender args _text) + "Handle PART message from SENDER. +ARGS should have the form (CHANNEL NICK REASON). +PROCESS is the process object for the current connection." (let* ((channel (car args)) (nick (cadr args)) (reason (nth 2 args)) @@ -2714,7 +2876,8 @@ the only argument." (rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason))) (defun rcirc-maybe-remember-nick-quit (process nick channel) - "Remember NICK as leaving CHANNEL if they recently spoke." + "Remember NICK as leaving CHANNEL if they recently spoke. +PROCESS is the process object for the current connection." (let ((elapsed-lines (rcirc-elapsed-lines process nick channel))) (when (and elapsed-lines (< elapsed-lines rcirc-omit-threshold)) @@ -2730,6 +2893,8 @@ the only argument." rcirc-recent-quit-alist)))))))))) (defun rcirc-handler-QUIT (process sender args _text) + "Handle QUIT message from SENDER. +PROCESS is the process object for the current connection." (rcirc-ignore-update-automatic sender) (mapc (lambda (channel) ;; broadcast quit message each channel @@ -2740,6 +2905,9 @@ the only argument." (rcirc-nick-remove process sender)) (defun rcirc-handler-NICK (process sender args _text) + "Handle NICK message from SENDER. +ARGS should have the form (NEW-NICK). +PROCESS is the process object for the current connection." (let* ((old-nick sender) (new-nick (car args)) (channels (rcirc-nick-channels process old-nick))) @@ -2771,21 +2939,31 @@ the only argument." (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) (defun rcirc-handler-PING (process _sender args _text) + "Respond to a PING with a PONG. +ARGS should have the form (MESSAGE). MESSAGE is relayed back to +the server. PROCESS is the process object for the current +connection." (rcirc-send-string process (concat "PONG :" (car args)))) + (defun rcirc-handler-PONG (_process _sender _args _text) - ;; do nothing - ) + "Ignore all incoming PONG messages.") (defun rcirc-handler-TOPIC (process sender args _text) + "Note the topic change from SENDER. +PROCESS is the process object for the current connection." (let ((topic (cadr args))) (rcirc-print process sender "TOPIC" (car args) topic) (with-current-buffer (rcirc-get-buffer process (car args)) (setq rcirc-topic topic)))) -(defvar rcirc-nick-away-alist nil) +(defvar rcirc-nick-away-alist nil + "Alist from nicks to away messages.") + (defun rcirc-handler-301 (process _sender args text) - "RPL_AWAY" + "Handle away messages (RPL_AWAY). +ARGS should have the form (NICK AWAY-MESSAGE). +PROCESS is the process object for the current connection." (let* ((nick (cadr args)) (rec (assoc-string nick rcirc-nick-away-alist)) (away-message (nth 2 args))) @@ -2799,7 +2977,9 @@ the only argument." rcirc-nick-away-alist)))))) (defun rcirc-handler-317 (process sender args _text) - "RPL_WHOISIDLE" + "Handle idle messages from SENDER (RPL_WHOISIDLE). +ARGS should have the form (NICK IDLE-SECS SIGNON-TIME). +PROCESS is the process object for the current connection." (let* ((nick (nth 1 args)) (idle-secs (string-to-number (nth 2 args))) (idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)) @@ -2810,15 +2990,20 @@ the only argument." (rcirc-print process sender "317" nil message t))) (defun rcirc-handler-332 (process _sender args _text) - "RPL_TOPIC" + "Update topic when notified by server (RPL_TOPIC). +ARGS should have the form (CHANNEL TOPIC). +PROCESS is the process object for the current connection." (let ((buffer (or (rcirc-get-buffer process (cadr args)) (rcirc-get-temp-buffer-create process (cadr args))))) (with-current-buffer buffer (setq rcirc-topic (nth 2 args))))) (defun rcirc-handler-333 (process sender args _text) - "333 says who set the topic and when. -Not in rfc1459.txt" + "Update when and who set the current topic. +ARGS has the form (CHANNEL SETTER TIME). SENDER is passed on to +`rcirc-print'. PROCESS is the process object for the current +connection. This is a non-standard extension, not specified in +RFC1459." (let ((buffer (or (rcirc-get-buffer process (cadr args)) (rcirc-get-temp-buffer-create process (cadr args))))) (with-current-buffer buffer @@ -2829,10 +3014,17 @@ Not in rfc1459.txt" (format "%s (%s on %s)" rcirc-topic setter time)))))) (defun rcirc-handler-477 (process sender args _text) - "ERR_NOCHANMODES" + "Notify user that CHANNEL does not support modes (ERR_NOCHANMODES). +ARGS has the form (CHANNEL MESSAGE). SENDER is passed on to +`rcirc-print'. PROCESS is the process object for the current +connection." (rcirc-print process sender "477" (cadr args) (nth 2 args))) (defun rcirc-handler-MODE (process sender args _text) + "Handle MODE messages. +ARGS should have the form (TARGET . MESSAGE-LIST). +SENDER is passed on to `rcirc-print'. +PROCESS is the process object for the current connection." (let ((target (car args)) (msg (mapconcat 'identity (cdr args) " "))) (rcirc-print process sender "MODE" @@ -2853,7 +3045,9 @@ Not in rfc1459.txt" (get-buffer-create tmpnam))) (defun rcirc-handler-353 (process _sender args _text) - "RPL_NAMREPLY" + "Start handling list of users (RPL_NAMREPLY). +ARGS should have the form (TYPE CHANNEL . NICK-LIST). +PROCESS is the process object for the current connection." (let ((channel (nth 2 args)) (names (or (nth 3 args) ""))) (mapc (lambda (nick) @@ -2866,7 +3060,9 @@ Not in rfc1459.txt" (insert (car (last args)) " ")))) (defun rcirc-handler-366 (process sender args _text) - "RPL_ENDOFNAMES" + "Handle end of user list (RPL_ENDOFNAMES). +SENDER is passed on to `rcirc-print'. +PROCESS is the process object for the current connection." (let* ((channel (cadr args)) (buffer (rcirc-get-temp-buffer-create process channel))) (with-current-buffer buffer @@ -2876,7 +3072,10 @@ Not in rfc1459.txt" (kill-buffer buffer))) (defun rcirc-handler-433 (process sender args text) - "ERR_NICKNAMEINUSE" + "Warn user that nick is used (ERR_NICKNAMEINUSE). +ARGS should have the form (NICK CHANNEL WARNING). +SENDER is passed on to `rcirc-handler-generic'. +PROCESS is the process object for the current connection." (rcirc-handler-generic process "433" sender args text) (with-rcirc-process-buffer process (let* ((length (string-to-number @@ -2885,8 +3084,10 @@ Not in rfc1459.txt" (rcirc-cmd-nick (rcirc--make-new-nick (cadr args) length) nil process)))) (defun rcirc--make-new-nick (nick length) - ;; If we already have some ` chars at the end, then shorten the - ;; non-` bit of the name. + "Attempt to create a unused nickname out of NICK. +A new nick may at most be LENGTH characters long. If we already +have some ` chars at the end, then shorten the non-` bit of the +name." (when (= (length nick) length) (setq nick (replace-regexp-in-string "[^`]\\(`+\\)\\'" "\\1" nick))) (concat @@ -2896,7 +3097,14 @@ Not in rfc1459.txt" "`")) (defun rcirc-handler-005 (process sender args text) - "ERR_NICKNAMEINUSE" + "Register supported server features (RPL_ISUPPORT). +ARGS should be a list of string feature parameters, either of the +form \"PARAMETER\" to enable a feature, \"PARAMETER=VALUE\" to +configure a specific option or \"-PARAMETER\" to disable a +previously specified feature. SENDER is passed on to +`rcirc-handler-generic'. PROCESS is the process object for the +current connection. Note that this is not the behaviour as +specified in RFC2812, where 005 stood for RPL_BOUNCE." (rcirc-handler-generic process "005" sender args text) (with-rcirc-process-buffer process (setq rcirc-server-parameters (append rcirc-server-parameters args)))) @@ -2941,12 +3149,27 @@ Passwords are stored in `rcirc-authinfo' (which see)." (format "AUTH %s %s" nick (car args)))))))))) (defun rcirc-handler-INVITE (process sender args _text) + "Notify user of an invitation. +SENDER and ARGS (in concatenated form) are passed on to +`rcirc-print'. PROCESS is the process object for the current +connection." (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t)) (defun rcirc-handler-ERROR (process sender args _text) + "Print a error message. +SENDER and ARGS (in concatenated form) are passed on to +`rcirc-print'. PROCESS is the process object for the current +connection." (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " "))) (defun rcirc-handler-CTCP (process target sender text) + "Handle Client-To-Client-Protocol message TEXT. +The message is addressed from SENDER to TARGET. Attempt to find +an appropriate handler, by invoicing the function +`rcirc-handler-ctcp-REQUEST', where REQUEST is the message type +as extracted from TEXT. If no handler was found, an error +message will be printed. PROCESS is the process object for the +current connection." (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text) (let* ((request (upcase (match-string 1 text))) (args (match-string 2 text)) @@ -2961,22 +3184,31 @@ Passwords are stored in `rcirc-authinfo' (which see)." (rcirc-print process sender "CTCP" target (format "%s" text) t)))))) -(defun rcirc-handler-ctcp-VERSION (process _target sender _args) +(defun rcirc-handler-ctcp-VERSION (process _target sender _message) + "Handle a CTCP VERSION message from SENDER. +PROCESS is the process object for the current connection." (rcirc-send-string process (concat "NOTICE " sender " :\C-aVERSION " rcirc-id-string "\C-a"))) -(defun rcirc-handler-ctcp-ACTION (process target sender args) - (rcirc-print process sender "ACTION" target args t)) +(defun rcirc-handler-ctcp-ACTION (process target sender message) + "Handle a CTCP ACTION MESSAGE from SENDER to TARGET. +PROCESS is the process object for the current connection." + (rcirc-print process sender "ACTION" target message t)) -(defun rcirc-handler-ctcp-TIME (process _target sender _args) +(defun rcirc-handler-ctcp-TIME (process _target sender _message) + "Respond to CTCP TIME message from SENDER. +PROCESS is the process object for the current connection." (rcirc-send-string process (concat "NOTICE " sender " :\C-aTIME " (current-time-string) "\C-a"))) (defun rcirc-handler-CTCP-response (process _target sender message) + "Handle CTCP response MESSAGE from SENDER. +PROCESS is the process object for the current connection." (rcirc-print process sender "CTCP" nil message t)) + (defgroup rcirc-faces nil "Faces for rcirc." @@ -3092,11 +3324,12 @@ Passwords are stored in `rcirc-authinfo' (which see)." ;; When using M-x flyspell-mode, only check words after the prompt (put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input) (defun rcirc-looking-at-input () - "Return true if point is past the input marker." + "Return non-nil if point is past the input marker." (>= (point) rcirc-prompt-end-marker)) (defun rcirc-server-parameter-value (parameter) + "Traverse `rcirc-server-parameters' for PARAMETER." (cl-loop for elem in rcirc-server-parameters for setting = (split-string elem "=") when (and (= (length setting) 2) commit c6b6c2d59626e3849691eb1ce747b33e43927ef2 Author: Philip Kaludercic Date: Wed Jun 9 16:09:55 2021 +0200 Use auth-source for user-passwords * (rcirc): Use auth-source is no password was specifed diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 90b61badf0..67dcf3e4ea 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -44,6 +44,7 @@ (require 'cl-lib) (require 'ring) (require 'time-date) +(require 'auth-source) (eval-when-compile (require 'subr-x)) (defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version)) @@ -500,6 +501,12 @@ If ARG is non-nil, instead prompt for connection parameters." (encryption (plist-get (cdr c) :encryption)) (server-alias (plist-get (cdr c) :server-alias)) contact) + (when-let (((not password)) + (auth (auth-source-search :host server + :user user-name + :port port)) + (fn (plist-get (car auth) :secret))) + (setq password (funcall fn))) (when server (let (connected) (dolist (p (rcirc-process-list)) commit 6898816b7d3fce001f37be6a95b5d287a76c9757 Author: Philip Kaludercic Date: Wed Jun 9 16:08:36 2021 +0200 Default to libera instead of freenode * rcirc.el (rcirc-server-alist): Update default value diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4fdb63e2eb..90b61badf0 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -56,10 +56,10 @@ :group 'applications) (defcustom rcirc-server-alist - '(("chat.freenode.net" :channels ("#rcirc") - ;; Don't use the TLS port by default, in case gnutls is not available. - ;; :port 7000 :encryption tls - )) + (if (gnutls-available-p) + '(("irc.libera.chat" :channels ("#rcirc") + :port 6697 :encryption tls)) + '(("irc.libera.chat" :channels ("#rcirc")))) "An alist of IRC connections to establish when running `rcirc'. Each element looks like (SERVER-NAME PARAMETERS). @@ -120,7 +120,8 @@ display purposes. If absent, the real server name will be displayed instead." (:channels (repeat string)) (:encryption (choice (const tls) (const plain))) - (:server-alias string))))) + (:server-alias string)))) + :version "28.1") (defcustom rcirc-default-port 6667 "The default port to connect to."