From 89f1634afcca318def07151424a21b81c70acd76 Mon Sep 17 00:00:00 2001 From: Alexandre Duret-Lutz Date: Mon, 11 Jan 2021 15:27:54 +0100 Subject: [PATCH 001/297] Fix problem with non-ASCII characters in nnmaildir * lisp/gnus/nnmaildir.el (nnmaildir-request-article): Enable multipart 8bit-content-transfer-encoded files to be displayed correctly by reading as `raw-text' instead of having Emacs (incorrectly) decode the files (bug#44307). Copyright-paperwork-exempt: yes --- lisp/gnus/nnmaildir.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 9cf766ee465..5461c4c960e 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1351,7 +1351,8 @@ This variable is set by `nnmaildir-request-article'.") (throw 'return nil)) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) - (nnheader-insert-file-contents nnmaildir-article-file-name)) + (let ((coding-system-for-read mm-text-coding-system)) + (mm-insert-file-contents nnmaildir-article-file-name))) (cons gname num-msgid)))) (defun nnmaildir-request-post (&optional _server) From 256356a36fa15c17968febfb3fa49ac33872a11e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Feb 2021 12:02:53 +0100 Subject: [PATCH 002/297] Clarify the "Sentinels" node in the lispref manual * doc/lispref/processes.texi (Sentinels): Mention "run" and that the strings can be anything (bug#30461). (cherry picked from commit 859a4cb6b22f75a3456e29d08fcfe9b8940fbe8b) --- doc/lispref/processes.texi | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 42f436501fd..063b5f51340 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1969,7 +1969,8 @@ describing the type of event. default sentinel function, which inserts a message in the process's buffer with the process name and the string describing the event. - The string describing the event looks like one of the following: + The string describing the event looks like one of the following (but +this is not an exhaustive list of event strings): @itemize @bullet @item @@ -1999,6 +2000,9 @@ core. @item @code{"open\n"}. +@item +@code{"run\n"}. + @item @code{"connection broken by remote peer\n"}. @end itemize From d1455027e0b04b67e903f5ef658a3fd65ca4da48 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Feb 2021 20:21:18 +0200 Subject: [PATCH 003/297] Initialize signal descriptions after pdumping * src/sysdep.c (init_signals) [!HAVE_DECL_SYS_SIGLIST]: Reinit sys_siglist also after pdumping. (Bug#46284) --- src/sysdep.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/sysdep.c b/src/sysdep.c index f94ce4d4920..d100a5cb50b 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1980,7 +1980,8 @@ init_signals (void) #endif #if !HAVE_DECL_SYS_SIGLIST && !defined _sys_siglist - if (! initialized) + if (! initialized + || dumped_with_pdumper_p ()) { sys_siglist[SIGABRT] = "Aborted"; # ifdef SIGAIO From 19534f988c0f29199dfd51d627392bccf7426253 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 9 Jan 2021 02:08:59 +0200 Subject: [PATCH 004/297] Make sure default-directory relates to the originating buffer * lisp/progmodes/xref.el (xref--show-xref-buffer): Pick up default-directory value from the caller (https://lists.gnu.org/archive/html/emacs-devel/2021-01/msg00551.html). (xref-show-definitions-buffer-at-bottom): Same. (cherry picked from commit 6e73e07a6f5cbdd1c5ae6e0f3fbd0f8f56813f1a) --- lisp/progmodes/xref.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 4c53c09d7b3..309f48a8177 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -852,8 +852,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (or (assoc-default 'fetched-xrefs alist) (funcall fetcher))) - (xref-alist (xref--analyze xrefs))) + (xref-alist (xref--analyze xrefs)) + (dd default-directory)) (with-current-buffer (get-buffer-create xref-buffer-name) + (setq default-directory dd) (xref--xref-buffer-mode) (xref--show-common-initialize xref-alist fetcher alist) (pop-to-buffer (current-buffer)) @@ -903,13 +905,15 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." When there is more than one definition, split the selected window and show the list in a small window at the bottom. And use a local keymap that binds `RET' to `xref-quit-and-goto-xref'." - (let ((xrefs (funcall fetcher))) + (let ((xrefs (funcall fetcher)) + (dd default-directory)) (cond ((not (cdr xrefs)) (xref-pop-to-location (car xrefs) (assoc-default 'display-action alist))) (t (with-current-buffer (get-buffer-create xref-buffer-name) + (setq default-directory dd) (xref--transient-buffer-mode) (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) (pop-to-buffer (current-buffer) From b99848c72cb2570cfcab98443be9156b66dee830 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 4 Feb 2021 03:38:27 +0200 Subject: [PATCH 005/297] Bind default-directory to the project root * lisp/progmodes/project.el (project-find-regexp): Bind default-directory to the project root, to save this value in the resulting buffer (esp. if the project selector was used, (https://lists.gnu.org/archive/html/emacs-devel/2021-02/msg00140.html). (project-or-external-find-regexp): Same. (cherry picked from commit c07ebfcbe084e8219d8c2588f23f77ba4ef39087) --- lisp/progmodes/project.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 1caf8bed7d2..2b35ea412f7 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -441,6 +441,7 @@ requires quoting, e.g. `\\[quoted-insert]'." (require 'xref) (require 'grep) (let* ((pr (project-current t)) + (default-directory (project-root pr)) (files (if (not current-prefix-arg) (project-files pr (project-roots pr)) @@ -473,6 +474,7 @@ pattern to search for." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) + (default-directory (project-root pr)) (files (project-files pr (append (project-roots pr) From fc37dc298f27025823fad2d944e11cc7ee6a058d Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 5 Feb 2021 01:17:09 +0200 Subject: [PATCH 006/297] Fix the previous change * lisp/progmodes/project.el (project-find-regexp): Fix the previous change (project-root is not defined in this version). (project-or-external-find-regexp): Same. --- lisp/progmodes/project.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 2b35ea412f7..ca0755cf8cd 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -441,7 +441,7 @@ requires quoting, e.g. `\\[quoted-insert]'." (require 'xref) (require 'grep) (let* ((pr (project-current t)) - (default-directory (project-root pr)) + (default-directory (car (project-roots pr))) (files (if (not current-prefix-arg) (project-files pr (project-roots pr)) @@ -474,7 +474,7 @@ pattern to search for." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) - (default-directory (project-root pr)) + (default-directory (car (project-roots pr))) (files (project-files pr (append (project-roots pr) From 8c27af3ff465fe78c635a8acd1debc9c63bfa7f3 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 5 Feb 2021 11:00:07 +0100 Subject: [PATCH 007/297] Clarify how transient indentation modes are exited in the manual * doc/emacs/indent.texi (Indentation Commands): Clarify that the other keys don't just exit the transient mode, but are also handled as normally (bug#46296). --- doc/emacs/indent.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index ceb911bef90..cca9432fa4f 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -136,8 +136,8 @@ this transient mode is active, typing @kbd{@key{LEFT}} or @kbd{@key{RIGHT}} indents leftward and rightward, respectively, by one space. You can also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to indent leftward or rightward to the next tab stop (@pxref{Tab Stops}). -Typing any other key disables the transient mode, and resumes normal -editing. +Typing any other key disables the transient mode, and this key is then +acted upon as normally. If called with a prefix argument @var{n}, this command indents the lines forward by @var{n} spaces (without enabling the transient mode). From 43bf7f1b06f5ca21a3af166e803b632934e6674d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 5 Feb 2021 09:36:58 +0100 Subject: [PATCH 008/297] Correct the lispref manual about flushing ppss info * doc/lispref/syntax.texi (Syntax Properties): Correct the information about flushing the state by copying the text from the doc string (bug#46274). (cherry picked from commit ff701ce2b261acce1dfcd1fe137268d87d5eab35) --- doc/lispref/syntax.texi | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index b4bd48771f0..58f07c9644d 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -573,10 +573,10 @@ and by Font Lock mode during syntactic fontification (@pxref{Syntactic Font Lock}). It is called with two arguments, @var{start} and @var{end}, which are the starting and ending positions of the text on which it should act. It is allowed to call @code{syntax-ppss} on any -position before @var{end}. However, it should not call -@code{syntax-ppss-flush-cache}; so, it is not allowed to call -@code{syntax-ppss} on some position and later modify the buffer at an -earlier position. +position before @var{end}, but if it calls @code{syntax-ppss} on some +position and later modifies the buffer on some earlier position, +then it is its responsibility to call @code{syntax-ppss-flush-cache} +to flush the now obsolete info from the cache. @strong{Caution:} When this variable is non-@code{nil}, Emacs removes @code{syntax-table} text properties arbitrarily and relies on From c71e08eba94fc821616ab8d48847ff7130974d61 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 5 Feb 2021 13:06:07 +0200 Subject: [PATCH 009/297] Fix last change in syntax.texi * doc/lispref/syntax.texi (Syntax Properties): Fix wording in last change. (Bug#46274) --- doc/lispref/syntax.texi | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 58f07c9644d..9adffcc18d3 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -573,10 +573,11 @@ and by Font Lock mode during syntactic fontification (@pxref{Syntactic Font Lock}). It is called with two arguments, @var{start} and @var{end}, which are the starting and ending positions of the text on which it should act. It is allowed to call @code{syntax-ppss} on any -position before @var{end}, but if it calls @code{syntax-ppss} on some -position and later modifies the buffer on some earlier position, -then it is its responsibility to call @code{syntax-ppss-flush-cache} -to flush the now obsolete info from the cache. +position before @var{end}, but if a Lisp program calls +@code{syntax-ppss} on some position and later modifies the buffer at +some earlier position, then it is that program's responsibility to +call @code{syntax-ppss-flush-cache} to flush the now obsolete info +from the cache. @strong{Caution:} When this variable is non-@code{nil}, Emacs removes @code{syntax-table} text properties arbitrarily and relies on From 6c5ddf0e0bc4e3e3ed819835f00419b7289d33c7 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sat, 6 Feb 2021 09:28:40 +0100 Subject: [PATCH 010/297] Fix two small tab bar issues * lisp/cus-start.el (frame-inhibit-implied-resize): Update version tag. * lisp/frame.el (frame-inner-height): Do not count in tab bar. --- lisp/cus-start.el | 2 +- lisp/frame.el | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 4b7c3863063..b7f0d7e2a85 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -336,7 +336,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "Never" nil) (const :tag "Always" t) (repeat (symbol :tag "Parameter"))) - "25.1") + "27.1") (iconify-child-frame frames (choice (const :tag "Do nothing" nil) diff --git a/lisp/frame.el b/lisp/frame.el index 7f1b8af9190..15e46c9e210 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1344,6 +1344,7 @@ FRAME defaults to the selected frame." FRAME defaults to the selected frame." (setq frame (window-normalize-frame frame)) (- (frame-native-height frame) + (tab-bar-height frame t) (* 2 (frame-internal-border-width frame)))) (defun frame-outer-width (&optional frame) From f853f2d42829326ef3606411e751b921e8ffed24 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 11:31:08 +0100 Subject: [PATCH 011/297] Avoid a compilation warning in iter-do * lisp/emacs-lisp/generator.el (iter-do): Avoid a compilation warning on using variables marked for not using (bug#31641). Eg. (iter-do (_ i)) --- lisp/emacs-lisp/generator.el | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index 9eb6d959645..e45260c32ac 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -725,17 +725,20 @@ Return the value with which ITERATOR finished iteration." (condition-symbol (cps--gensym "iter-do-condition")) (it-symbol (cps--gensym "iter-do-iterator")) (result-symbol (cps--gensym "iter-do-result"))) - `(let (,var - ,result-symbol + `(let (,result-symbol (,done-symbol nil) (,it-symbol ,iterator)) - (while (not ,done-symbol) - (condition-case ,condition-symbol - (setf ,var (iter-next ,it-symbol)) - (iter-end-of-sequence - (setf ,result-symbol (cdr ,condition-symbol)) - (setf ,done-symbol t))) - (unless ,done-symbol ,@body)) + (while + (let ((,var + (condition-case ,condition-symbol + (iter-next ,it-symbol) + (iter-end-of-sequence + (setf ,result-symbol (cdr ,condition-symbol)) + (setf ,done-symbol t))))) + (unless ,done-symbol + ,@body + ;; Loop until done-symbol is set. + t))) ,result-symbol))) (defvar cl--loop-args) From 293264623235fdcf672eec3f8e88e4ec7e1182e4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 11:40:00 +0100 Subject: [PATCH 012/297] Fix problem when ~/.mailcap had several entries for a MIME type * lisp/net/mailcap.el (mailcap-mime-info): Use all the matching entries from ~/.mailcap, not just the first (bug#46318). --- lisp/net/mailcap.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 455673b5e9f..b95cd0febcd 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -842,11 +842,11 @@ If NO-DECODE is non-nil, don't decode STRING." ;; ~/.mailcap file, then we filter out the system entries ;; and see whether we have anything left. (when mailcap-prefer-mailcap-viewers - (when-let ((user-entry - (seq-find (lambda (elem) - (eq (cdr (assq 'source elem)) 'user)) - passed))) - (setq passed (list user-entry)))) + (when-let ((user-entries + (seq-filter (lambda (elem) + (eq (cdr (assq 'source elem)) 'user)) + passed))) + (setq passed user-entries))) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) From 7a25ff767df7a323898a59531a1c518b1bc28699 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 11:46:58 +0100 Subject: [PATCH 013/297] Clarify the indent-rigidly doc string * lisp/indent.el (indent-rigidly): Clarify exiting the transient mode (bug#46296). --- lisp/indent.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/indent.el b/lisp/indent.el index ea71e88b8b6..ed67e1c16f7 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -212,7 +212,8 @@ It is activated by calling `indent-rigidly' interactively.") If called interactively with no prefix argument, activate a transient mode in which the indentation can be adjusted interactively by typing \\\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]. -Typing any other key deactivates the transient mode. +Typing any other key deactivates the transient mode, and this key is then +acted upon as normally. If called from a program, or interactively with prefix ARG, indent all lines starting in the region forward by ARG columns. From 23a7da9148c84dbcc228dda37c9bcebfc2a004d2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 6 Feb 2021 11:50:55 +0100 Subject: [PATCH 014/297] Modernize use of prompts in auth-source.el * lisp/auth-source.el (auth-source-search): Adapt docstring (auth-source-format-prompt): Remove trailing ": ". (auth-source-netrc-create, auth-source-secrets-create) (auth-source-plstore-create): Adapt prompts. Use `format-prompt'. Do not ask interactively if `auth-source-save-behavior' is nil. --- lisp/auth-source.el | 77 ++++++++++++++++++++++----------------------- 1 file changed, 37 insertions(+), 40 deletions(-) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 2494040457b..14cae8a52c7 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -581,14 +581,15 @@ default value. If the user, host, or port are missing, the alist `auth-source-creation-prompts' will be used to look up the prompts IN THAT ORDER (so the `user' prompt will be queried first, then `host', then `port', and finally `secret'). Each prompt string -can use %u, %h, and %p to show the user, host, and port. +can use %u, %h, and %p to show the user, host, and port. The prompt +is formatted with `format-prompt', a trailing \": \" is removed. Here's an example: \(let ((auth-source-creation-defaults \\='((user . \"defaultUser\") (A . \"default A\"))) (auth-source-creation-prompts - \\='((secret . \"Enter IMAP password for %h:%p: \")))) + \\='((secret . \"Enter IMAP password for %h:%p\")))) (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1 :P \"pppp\" :Q \"qqqq\" :create \\='(A B Q))) @@ -860,7 +861,9 @@ while \(:host t) would find all host entries." secret))) (defun auth-source-format-prompt (prompt alist) - "Format PROMPT using %x (for any character x) specifiers in ALIST." + "Format PROMPT using %x (for any character x) specifiers in ALIST. +Remove trailing \": \"." + (setq prompt (replace-regexp-in-string ":\\s-*$" "" prompt)) (dolist (cell alist) (let ((c (nth 0 cell)) (v (nth 1 cell))) @@ -1344,11 +1347,11 @@ See `auth-source-search' for details on SPEC." "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -1378,7 +1381,9 @@ See `auth-source-search' for details on SPEC." (setq check nil))) ret)) (t 'never))) - (plain (or (eval default) (read-passwd prompt)))) + (plain + (or (eval default) + (read-passwd (format-prompt prompt nil))))) ;; ask if we don't know what to do (in which case ;; auth-source-netrc-use-gpg-tokens must be a list) (unless gpg-encrypt @@ -1390,12 +1395,9 @@ See `auth-source-search' for details on SPEC." (if (eq gpg-encrypt 'gpg) (auth-source-epa-make-gpg-token plain file) plain)) - (if (stringp default) - (read-string (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (if (and (stringp default) auth-source-save-behavior) + (read-string + (format-prompt prompt default) nil nil default) (eval default))))) (when data @@ -1745,12 +1747,12 @@ authentication tokens: "[any label]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ") - (label "Enter label for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h") + (label "Enter label for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -1760,13 +1762,11 @@ authentication tokens: ;; Store the data, prompting for the password if needed. (setq data (or data (if (eq r 'secret) - (or (eval default) (read-passwd prompt)) - (if (stringp default) - (read-string (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (or (eval default) + (read-passwd (format-prompt prompt nil))) + (if (and (stringp default) auth-source-save-behavior) + (read-string + (format-prompt prompt default) nil nil default) (eval default))))) (when data @@ -2190,11 +2190,11 @@ entries for git.gnus.org: "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -2204,14 +2204,11 @@ entries for git.gnus.org: ;; Store the data, prompting for the password if needed. (setq data (or data (if (eq r 'secret) - (or (eval default) (read-passwd prompt)) - (if (stringp default) + (or (eval default) + (read-passwd (format-prompt prompt nil))) + (if (and (stringp default) auth-source-save-behavior) (read-string - (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (format-prompt prompt default) nil nil default) (eval default))))) (when data From 2476abc1f24f1b2385648cfb08cd9f178422497d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 12:03:43 +0100 Subject: [PATCH 015/297] Allow provided-mode-derived-p to work on aliases * lisp/subr.el (provided-mode-derived-p): Allow this to work on modes that are aliases of other modes (bug#46331). For instance: (provided-mode-derived-p 'javascript-mode 'prog-mode) --- lisp/subr.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/subr.el b/lisp/subr.el index 6e52bd20df2..c1624aa9c02 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2231,6 +2231,10 @@ Affects only hooks run in the current buffer." "Non-nil if MODE is derived from one of MODES or their aliases. Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." + ;; If MODE is an alias, then look up the real mode function first. + (when-let ((alias (symbol-function mode))) + (when (symbolp alias) + (setq mode alias))) (while (and (not (memq mode modes)) From cf0869d22bc62ae255bf5f824a02c92878c5c6cc Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 12:28:46 +0100 Subject: [PATCH 016/297] Rename the `1value' symbol in testcover.el * lisp/emacs-lisp/testcover.el: Rename the symbol `1value' throughout the file to `testcover-1value' to allow using the variable in code that's to be tested (bug#25471). --- lisp/emacs-lisp/testcover.el | 60 ++++++++++++++++++------------------ 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 312e38769c5..50f2b51637c 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -258,10 +258,10 @@ vector. Return VALUE." (aset testcover-vector after-index (testcover--copy-object value))) ((eq 'maybe old-result) (aset testcover-vector after-index 'edebug-ok-coverage)) - ((eq '1value old-result) + ((eq 'testcover-1value old-result) (aset testcover-vector after-index (cons old-result (testcover--copy-object value)))) - ((and (eq (car-safe old-result) '1value) + ((and (eq (car-safe old-result) 'testcover-1value) (not (condition-case () (equal (cdr old-result) value) (circular-list t)))) @@ -358,11 +358,11 @@ eliminated by adding more test cases." data (aref coverage len)) (when (and (not (eq data 'edebug-ok-coverage)) (not (memq (car-safe data) - '(1value maybe noreturn))) + '(testcover-1value maybe noreturn))) (setq j (+ def-mark (aref points len)))) (setq ov (make-overlay (1- j) j)) (overlay-put ov 'face - (if (memq data '(edebug-unknown maybe 1value)) + (if (memq data '(edebug-unknown maybe testcover-1value)) 'testcover-nohits 'testcover-1value)))) (set-buffer-modified-p changed)))) @@ -450,12 +450,12 @@ or return multiple values." (`(defconst ,sym . ,args) (push sym testcover-module-constants) (testcover-analyze-coverage-progn args) - '1value) + 'testcover-1value) (`(defun ,name ,_ . ,doc-and-body) (let ((val (testcover-analyze-coverage-progn doc-and-body))) (cl-case val - ((1value) (push name testcover-module-1value-functions)) + ((testcover-1value) (push name testcover-module-1value-functions)) ((maybe) (push name testcover-module-potentially-1value-functions))) nil)) @@ -466,13 +466,13 @@ or return multiple values." ;; To avoid infinite recursion, don't examine quoted objects. ;; This will cause the coverage marks on an instrumented quoted ;; form to look odd. See bug#25316. - '1value) + 'testcover-1value) (`(\` ,bq-form) (testcover-analyze-coverage-backquote-form bq-form)) ((or 't 'nil (pred keywordp)) - '1value) + 'testcover-1value) ((pred vectorp) (testcover-analyze-coverage-compose (append form nil) @@ -482,7 +482,7 @@ or return multiple values." nil) ((pred atom) - '1value) + 'testcover-1value) (_ ;; Whatever we have here, it's not wrapped, so treat it as a list of forms. @@ -494,7 +494,7 @@ Analyze all the forms in FORMS and return 1value, maybe or nil depending on the analysis of the last one. Find the coverage vectors referenced by `edebug-enter' forms nested within FORMS and update them with the results of the analysis." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp forms) (setq result (testcover-analyze-coverage (pop forms)))) result)) @@ -516,9 +516,9 @@ form to be treated accordingly." (aset testcover-vector before-id 'edebug-ok-coverage)) (setq val (testcover-analyze-coverage-wrapped-form wrapped-form)) - (when (or (eq wrapper '1value) val) + (when (or (eq wrapper 'testcover-1value) val) ;; The form is 1-valued or potentially 1-valued. - (aset testcover-vector after-id (or val '1value))) + (aset testcover-vector after-id (or val 'testcover-1value))) (cond ((or (eq wrapper 'noreturn) @@ -526,13 +526,13 @@ form to be treated accordingly." ;; This function won't return, so indicate to testcover-before that ;; it should record coverage. (aset testcover-vector before-id (cons 'noreturn after-id)) - (aset testcover-vector after-id '1value) - (setq val '1value)) + (aset testcover-vector after-id 'testcover-1value) + (setq val 'testcover-1value)) - ((eq (car-safe wrapped-form) '1value) + ((eq (car-safe wrapped-form) 'testcover-1value) ;; This function is always supposed to return the same value. - (setq val '1value) - (aset testcover-vector after-id '1value))) + (setq val 'testcover-1value) + (aset testcover-vector after-id 'testcover-1value))) val)) (defun testcover-analyze-coverage-wrapped-form (form) @@ -540,26 +540,26 @@ form to be treated accordingly." FORM is treated as if it will be evaluated." (pcase form ((pred keywordp) - '1value) + 'testcover-1value) ((pred symbolp) (when (or (memq form testcover-constants) (memq form testcover-module-constants)) - '1value)) + 'testcover-1value)) ((pred atom) - '1value) + 'testcover-1value) (`(\` ,bq-form) (testcover-analyze-coverage-backquote-form bq-form)) (`(defconst ,sym ,val . ,_) (push sym testcover-module-constants) (testcover-analyze-coverage val) - '1value) + 'testcover-1value) (`(,(or 'dotimes 'dolist) (,_ ,expr . ,result) . ,body) ;; These always return RESULT if provided. (testcover-analyze-coverage expr) (testcover-analyze-coverage-progn body) (let ((val (testcover-analyze-coverage-progn result))) ;; If the third value is not present, the loop always returns nil. - (if result val '1value))) + (if result val 'testcover-1value))) (`(,(or 'let 'let*) ,bindings . ,body) (testcover-analyze-coverage-progn bindings) (testcover-analyze-coverage-progn body)) @@ -586,9 +586,9 @@ FORM is treated as if it will be evaluated." ;; depending on the symbol. (let ((temp-form (cons func args))) (testcover-analyze-coverage-wrapped-form temp-form))) - (`(,(and func (or '1value 'noreturn)) ,inner-form) + (`(,(and func (or 'testcover-1value 'noreturn)) ,inner-form) ;; 1value and noreturn change how the edebug-after they wrap is handled. - (let ((val (if (eq func '1value) '1value 'maybe))) + (let ((val (if (eq func 'testcover-1value) 'testcover-1value 'maybe))) (pcase inner-form (`(edebug-after ,(and before-form (or `(edebug-before ,before-id) before-id)) @@ -604,12 +604,12 @@ FORM is treated as if it will be evaluated." (defun testcover-analyze-coverage-wrapped-application (func args) "Analyze the application of FUNC to ARGS for code coverage." (cond - ((eq func 'quote) '1value) + ((eq func 'quote) 'testcover-1value) ((or (memq func testcover-1value-functions) (memq func testcover-module-1value-functions)) ;; The function should always return the same value. (testcover-analyze-coverage-progn args) - '1value) + 'testcover-1value) ((or (memq func testcover-potentially-1value-functions) (memq func testcover-module-potentially-1value-functions)) ;; The function might always return the same value. @@ -635,14 +635,14 @@ If either argument is nil, return nil, otherwise if either argument is maybe, return maybe. Return 1value only if both arguments are 1value." (cl-case val - (1value result) + (testcover-1value result) (maybe (and result 'maybe)) (nil nil))) (defun testcover-analyze-coverage-compose (forms func) "Analyze a list of FORMS for code coverage using FUNC. The list is 1valued if all of its constituent elements are also 1valued." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp forms) (setq result (testcover-coverage-combine result (funcall func (car forms)))) (setq forms (cdr forms))) @@ -652,7 +652,7 @@ The list is 1valued if all of its constituent elements are also 1valued." (defun testcover-analyze-coverage-backquote (bq-list) "Analyze BQ-LIST, the body of a backquoted list, for code coverage." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp bq-list) (let ((form (car bq-list)) val) @@ -670,7 +670,7 @@ The list is 1valued if all of its constituent elements are also 1valued." "Analyze a single FORM from a backquoted list for code coverage." (cond ((vectorp form) (testcover-analyze-coverage-backquote (append form nil))) - ((atom form) '1value) + ((atom form) 'testcover-1value) ((memq (car form) (list '\, '\,@)) (testcover-analyze-coverage (cadr form))) (t (testcover-analyze-coverage-backquote form)))) From 0100e33f83eaf1e6698c168c4118cf84a1792496 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 13:26:25 +0100 Subject: [PATCH 017/297] Warn in message.el when sending encryptable mail * lisp/gnus/message.el (message-send): Query if it looks like encryption was intended, but is not going to happen. * lisp/gnus/mml-sec.el (mml-secure-is-encrypted-p): Allow saying whether there's any <#secure tags present (bug#24411). --- lisp/gnus/message.el | 4 ++++ lisp/gnus/mml-sec.el | 15 +++++++++------ 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 6668784f93c..5a5dbcebc1e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4315,6 +4315,10 @@ It should typically alter the sending method in some way or other." (when message-confirm-send (or (y-or-n-p "Send message? ") (keyboard-quit))) + (when (and (not (mml-secure-is-encrypted-p)) + (mml-secure-is-encrypted-p 'anywhere) + (not (yes-or-no-p "This message has a <#secure tag, but is not going to be encrypted. Send anyway?"))) + (error "Aborting sending")) (message message-sending-message) (let ((alist message-send-method-alist) (success t) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 8d01d15ca01..d41c9dd0d9a 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -298,14 +298,17 @@ Use METHOD if given. Else use `mml-secure-method' or (interactive) (mml-secure-part "smime")) -(defun mml-secure-is-encrypted-p () - "Check whether secure encrypt tag is present." +(defun mml-secure-is-encrypted-p (&optional tag-present) + "Whether the current buffer contains a mail message that should be encrypted. +If TAG-PRESENT, say whether the <#secure tag is present anywhere +in the buffer." (save-excursion (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n" - "<#secure[^>]+encrypt") - nil t))) + (message-goto-body) + (if tag-present + (re-search-forward "<#secure[^>]+encrypt" nil t) + (skip-chars-forward "[ \t\n") + (looking-at "<#secure[^>]+encrypt")))) (defun mml-secure-bcc-is-safe () "Check whether usage of Bcc is safe (or absent). From 8ad48a0bdd0806fe3bfbabf00c845381d9107cb0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 14:31:51 +0200 Subject: [PATCH 018/297] Improve doc string of 'text-scale-adjust' * lisp/face-remap.el (text-scale-adjust): Clarify that "default face height" refers to the 'default' face. (Bug#25168) --- lisp/face-remap.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 49b01d02a3d..6c3f4082fdf 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -325,9 +325,9 @@ INC may be passed as a numeric prefix argument. The actual adjustment made depends on the final component of the key-binding used to invoke the command, with all modifiers removed: - +, = Increase the default face height by one step - - Decrease the default face height by one step - 0 Reset the default face height to the global default + +, = Increase the height of the default face by one step + - Decrease the height of the default face by one step + 0 Reset the height of the default face to the global default After adjusting, continue to read input events and further adjust the face height as long as the input event read From 5903db0c2049c588f6b15717a8f9bd4c6a6f46a4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 13:54:33 +0100 Subject: [PATCH 019/297] Tweak provided-mode-derived-p doc string * lisp/subr.el (provided-mode-derived-p): Remove detail about "or their aliases", since that seems self-evident (bug#46331) (and derived-mode-p works the same, and doesn't have the bit in question). --- lisp/subr.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/subr.el b/lisp/subr.el index c1624aa9c02..f0de6d5ac92 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2228,7 +2228,7 @@ Affects only hooks run in the current buffer." ;; PUBLIC: find if the current mode derives from another. (defun provided-mode-derived-p (mode &rest modes) - "Non-nil if MODE is derived from one of MODES or their aliases. + "Non-nil if MODE is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." ;; If MODE is an alias, then look up the real mode function first. From f534d3fdacb3d6114a0ebdc8df2723265339db5d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 15:09:32 +0200 Subject: [PATCH 020/297] Support file names with whitespace in Nroff mode * lisp/textmodes/nroff-mode.el (nroff-view): Quote argument of 'Man-getpage-in-background' to support file names with special characters. (Bug#46051) --- lisp/textmodes/nroff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index fe70e925b05..e7d852be3c8 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -316,7 +316,7 @@ otherwise off." (save-buffer)) (if viewbuf (kill-buffer viewbuf)) - (Man-getpage-in-background file))) + (Man-getpage-in-background (shell-quote-argument file)))) (provide 'nroff-mode) From c4a6f81ca4405a91ba04797ec5aced98c3c6decf Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 15:04:52 +0100 Subject: [PATCH 021/297] Fix previous change in testcover.el * lisp/emacs-lisp/testcover.el (testcover-analyze-coverage-edebug-after): The wrapper macro is called `1value', not `testcover-1value'. --- lisp/emacs-lisp/testcover.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 50f2b51637c..75b27d08e56 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -516,7 +516,7 @@ form to be treated accordingly." (aset testcover-vector before-id 'edebug-ok-coverage)) (setq val (testcover-analyze-coverage-wrapped-form wrapped-form)) - (when (or (eq wrapper 'testcover-1value) val) + (when (or (eq wrapper '1value) val) ;; The form is 1-valued or potentially 1-valued. (aset testcover-vector after-id (or val 'testcover-1value))) @@ -529,7 +529,7 @@ form to be treated accordingly." (aset testcover-vector after-id 'testcover-1value) (setq val 'testcover-1value)) - ((eq (car-safe wrapped-form) 'testcover-1value) + ((eq (car-safe wrapped-form) '1value) ;; This function is always supposed to return the same value. (setq val 'testcover-1value) (aset testcover-vector after-id 'testcover-1value))) @@ -586,9 +586,9 @@ FORM is treated as if it will be evaluated." ;; depending on the symbol. (let ((temp-form (cons func args))) (testcover-analyze-coverage-wrapped-form temp-form))) - (`(,(and func (or 'testcover-1value 'noreturn)) ,inner-form) + (`(,(and func (or '1value 'noreturn)) ,inner-form) ;; 1value and noreturn change how the edebug-after they wrap is handled. - (let ((val (if (eq func 'testcover-1value) 'testcover-1value 'maybe))) + (let ((val (if (eq func '1value) '1value 'maybe))) (pcase inner-form (`(edebug-after ,(and before-form (or `(edebug-before ,before-id) before-id)) From 29e9cf291eb35a77ad782e56effddf2fa00ee96c Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sat, 6 Feb 2021 18:22:29 +0100 Subject: [PATCH 022/297] Permit zero value for 'child-frame-border-width' parameter (Bug#46184) * doc/lispref/frames.texi (Layout Parameters): Update entry on 'child-frame-border-width' parameter. * src/frame.c (make_frame): Init child_frame_border_width to -1. (Fframe_child_frame_border_width): Return internal border width if child frame border width parameter is nil. (gui_report_frame_params): Report nil as child frame border width parameter if the frame value is negative. * src/frame.h (FRAME_INTERNAL_BORDER_WIDTH): Return value of child frame border width only if it is not negative. * src/xfns.c (Fx_create_frame): Default child frame border to -1 when recording it in its frame slot via gui_default_parameter. * src/nsfns.m (ns_set_child_frame_border_width): Handle nil ARG. (Fx_create_frame): Default child frame border width parameter to nil. * src/w32fns.c (w32_set_child_frame_border_width): Handle nil ARG. (Fx_create_frame): Default child frame border width parameter to nil. * src/xfns.c (x_set_child_frame_border_width): Handle nil ARG. (Fx_create_frame): Default child frame border width parameter to nil. --- doc/lispref/frames.texi | 2 ++ src/frame.c | 16 +++++++++++--- src/frame.h | 10 ++++----- src/nsfns.m | 25 +++++++++++++-------- src/w32fns.c | 30 ++++++++++++++------------ src/xfns.c | 48 +++++++++++++++++++++-------------------- 6 files changed, 77 insertions(+), 54 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a15511dc9f5..f4316b753d8 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1802,6 +1802,8 @@ Geometry}). @item child-frame-border-width The width in pixels of the frame's internal border (@pxref{Frame Geometry}) if the given frame is a child frame (@pxref{Child Frames}). +If this is @code{nil}, the value specified by the +@code{internal-border-width} parameter is used instead. @vindex vertical-scroll-bars@r{, a frame parameter} @item vertical-scroll-bars diff --git a/src/frame.c b/src/frame.c index a2167ce1e49..635fc945604 100644 --- a/src/frame.c +++ b/src/frame.c @@ -898,6 +898,7 @@ make_frame (bool mini_p) f->no_accept_focus = false; f->z_group = z_group_none; f->tooltip = false; + f->child_frame_border_width = -1; f->last_tab_bar_item = -1; #ifndef HAVE_EXT_TOOL_BAR f->last_tool_bar_item = -1; @@ -3544,10 +3545,17 @@ DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0, } DEFUN ("frame-child-frame-border-width", Fframe_child_frame_border_width, Sframe_child_frame_border_width, 0, 1, 0, - doc: /* Return width of FRAME's child-frame border in pixels. */) + doc: /* Return width of FRAME's child-frame border in pixels. + If FRAME's 'child-frame-border-width' parameter is nil, return FRAME's + internal border width instead. */) (Lisp_Object frame) { - return make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame (frame))); + int width = FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame (frame)); + + if (width < 0) + return make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame))); + else + return make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame (frame))); } DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0, @@ -4311,7 +4319,9 @@ gui_report_frame_params (struct frame *f, Lisp_Object *alistptr) store_in_alist (alistptr, Qborder_width, make_fixnum (f->border_width)); store_in_alist (alistptr, Qchild_frame_border_width, - make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (f))); + FRAME_CHILD_FRAME_BORDER_WIDTH (f) >= 0 + ? make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (f)) + : Qnil); store_in_alist (alistptr, Qinternal_border_width, make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f))); store_in_alist (alistptr, Qright_divider_width, diff --git a/src/frame.h b/src/frame.h index 21148fe94c9..9ddcb4c6810 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1449,11 +1449,11 @@ INLINE int FRAME_INTERNAL_BORDER_WIDTH (struct frame *f) { #ifdef HAVE_WINDOW_SYSTEM - return FRAME_PARENT_FRAME(f) - ? (f->child_frame_border_width - ? FRAME_CHILD_FRAME_BORDER_WIDTH(f) - : frame_dimension (f->internal_border_width)) - : frame_dimension (f->internal_border_width); + return (FRAME_PARENT_FRAME(f) + ? (FRAME_CHILD_FRAME_BORDER_WIDTH(f) >= 0 + ? FRAME_CHILD_FRAME_BORDER_WIDTH(f) + : frame_dimension (f->internal_border_width)) + : frame_dimension (f->internal_border_width)); #else return frame_dimension (f->internal_border_width); #endif diff --git a/src/nsfns.m b/src/nsfns.m index c7857eac731..5c4cc915e7c 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -690,17 +690,24 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. static void ns_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int old_width = FRAME_CHILD_FRAME_BORDER_WIDTH (f); - int new_width = check_int_nonnegative (arg); + int border; - if (new_width == old_width) - return; - f->child_frame_border_width = new_width; + if (NILP (arg)) + border = -1; + else if (RANGED_FIXNUMP (0, arg, INT_MAX)) + border = XFIXNAT (arg); + else + signal_error ("Invalid child frame border width", arg); - if (FRAME_NATIVE_WINDOW (f) != 0) - adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width); + if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f)) + { + f->child_frame_border_width = border; - SET_FRAME_GARBAGED (f); + if (FRAME_NATIVE_WINDOW (f) != 0) + adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width); + + SET_FRAME_GARBAGED (f); + } } static void @@ -1213,7 +1220,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2), "internalBorderWidth", "InternalBorderWidth", RES_TYPE_NUMBER); - gui_default_parameter (f, parms, Qchild_frame_border_width, make_fixnum (2), + gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil, "childFrameBorderWidth", "childFrameBorderWidth", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), diff --git a/src/w32fns.c b/src/w32fns.c index 5704f1d3c33..86c3db64e7b 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -1561,8 +1561,14 @@ w32_clear_under_internal_border (struct frame *f) static void w32_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int argval = check_integer_range (arg, INT_MIN, INT_MAX); - int border = max (argval, 0); + int border; + + if (NILP (arg)) + border = -1; + else if (RANGED_FIXNUMP (0, arg, INT_MAX)) + border = XFIXNAT (arg); + else + signal_error ("Invalid child frame border width", arg); if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f)) { @@ -5896,37 +5902,33 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, Lisp_Object value; value = gui_display_get_arg (dpyinfo, parameters, Qinternal_border_width, - "internalBorder", "InternalBorder", + "internalBorder", "internalBorder", RES_TYPE_NUMBER); if (! EQ (value, Qunbound)) parameters = Fcons (Fcons (Qinternal_border_width, value), parameters); } + gui_default_parameter (f, parameters, Qinternal_border_width, make_fixnum (0), + "internalBorderWidth", "internalBorderWidth", + RES_TYPE_NUMBER); + /* Same for child frames. */ if (NILP (Fassq (Qchild_frame_border_width, parameters))) { Lisp_Object value; value = gui_display_get_arg (dpyinfo, parameters, Qchild_frame_border_width, - "childFrameBorderWidth", "childFrameBorderWidth", + "childFrameBorder", "childFrameBorder", RES_TYPE_NUMBER); - if (! EQ (value, Qunbound)) + if (!EQ (value, Qunbound)) parameters = Fcons (Fcons (Qchild_frame_border_width, value), parameters); - } - gui_default_parameter (f, parameters, Qchild_frame_border_width, -#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */ - make_fixnum (0), -#else - make_fixnum (1), -#endif + gui_default_parameter (f, parameters, Qchild_frame_border_width, Qnil, "childFrameBorderWidth", "childFrameBorderWidth", RES_TYPE_NUMBER); - gui_default_parameter (f, parameters, Qinternal_border_width, make_fixnum (0), - "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER); gui_default_parameter (f, parameters, Qright_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); gui_default_parameter (f, parameters, Qbottom_divider_width, make_fixnum (0), diff --git a/src/xfns.c b/src/xfns.c index cac41ee4856..481ee0e2255 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1803,7 +1803,14 @@ x_change_tool_bar_height (struct frame *f, int height) static void x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int border = check_int_nonnegative (arg); + int border; + + if (NILP (arg)) + border = -1; + else if (RANGED_FIXNUMP (0, arg, INT_MAX)) + border = XFIXNAT (arg); + else + signal_error ("Invalid child frame border width", arg); if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f)) { @@ -3920,28 +3927,6 @@ This function is an internal primitive--use `make-frame' instead. */) parms); } - /* Same for child frames. */ - if (NILP (Fassq (Qchild_frame_border_width, parms))) - { - Lisp_Object value; - - value = gui_display_get_arg (dpyinfo, parms, Qchild_frame_border_width, - "childFrameBorderWidth", "childFrameBorderWidth", - RES_TYPE_NUMBER); - if (! EQ (value, Qunbound)) - parms = Fcons (Fcons (Qchild_frame_border_width, value), - parms); - - } - - gui_default_parameter (f, parms, Qchild_frame_border_width, -#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */ - make_fixnum (0), -#else - make_fixnum (1), -#endif - "childFrameBorderWidth", "childFrameBorderWidth", - RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qinternal_border_width, #ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */ make_fixnum (0), @@ -3950,6 +3935,23 @@ This function is an internal primitive--use `make-frame' instead. */) #endif "internalBorderWidth", "internalBorderWidth", RES_TYPE_NUMBER); + + /* Same for child frames. */ + if (NILP (Fassq (Qchild_frame_border_width, parms))) + { + Lisp_Object value; + + value = gui_display_get_arg (dpyinfo, parms, Qchild_frame_border_width, + "childFrameBorder", "childFrameBorder", + RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qchild_frame_border_width, value), + parms); + } + + gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil, + "childFrameBorderWidth", "childFrameBorderWidth", + RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), From b76864ef5513a9c1f7fe1138266dfab47f6fe350 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 6 Feb 2021 09:29:53 -0800 Subject: [PATCH 023/297] Fix TEXT check in gnus-search IMAP search * lisp/gnus/gnus-search.el (gnus-search-run-search): It's a string, not a buffer! --- lisp/gnus/gnus-search.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index f3e08519c3e..0783d34733a 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1040,7 +1040,7 @@ Responsible for handling and, or, and parenthetical expressions.") ;; A bit of backward-compatibility slash convenience: if the ;; query string doesn't start with any known IMAP search ;; keyword, assume it is a "TEXT" search. - (unless (or (looking-at "(") + (unless (or (eql ?\( (aref q-string 0)) (and (string-match "\\`[^[:blank:]]+" q-string) (memql (intern-soft (downcase (match-string 0 q-string))) From d640ec27183c9424daaf2d5dcb683ed1ff39d036 Mon Sep 17 00:00:00 2001 From: Ioannis Kappas Date: Wed, 3 Feb 2021 22:50:54 +0000 Subject: [PATCH 024/297] New test for src/process.c on MS-Windows * test/src/process-tests.el (process-sentinel-interrupt-event): New test. (Bug#46284) Copyright-paperwork-exempt: yes --- test/src/process-tests.el | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index a3fba8d328b..950d0814c2a 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -879,5 +879,34 @@ Return nil if FILENAME doesn't exist." (file-regular-p filename) filename))) +;; Bug#46284 +(ert-deftest process-sentinel-interrupt-event () + "Test that interrupting a process on MS-Windows sends the + \"interrupt\" event to the process sentinel." + (skip-unless (eq system-type 'windows-nt)) + (with-temp-buffer + (let* ((proc-buf (current-buffer)) + ;; Start a new emacs process to wait idly until interrupted. + (cmd "emacs -batch --eval=\"(sit-for 50000)\"") + (proc (start-file-process-shell-command + "test/process-sentinel-signal-event" proc-buf cmd)) + (events '())) + + ;; Capture any incoming events. + (set-process-sentinel proc + (lambda (proc event) + (push event events))) + ;; Wait for the process to start. + (sleep-for 2) + (should (equal 'run (process-status proc))) + ;; Interrupt the sub-process and wait for it to die. + (interrupt-process proc) + (sleep-for 2) + ;; Should have received SIGINT... + (should (equal 'signal (process-status proc))) + (should (equal 2 (process-exit-status proc))) + ;; ...and the change description should be "interrupt". + (should (equal '("interrupt\n") events))))) + (provide 'process-tests) ;;; process-tests.el ends here From a3b182954ccf10a0c21568bd91f7725db575690e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 20:20:31 +0200 Subject: [PATCH 025/297] ; Fix last change --- test/src/process-tests.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 950d0814c2a..b2e0ec19de1 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -881,8 +881,7 @@ Return nil if FILENAME doesn't exist." ;; Bug#46284 (ert-deftest process-sentinel-interrupt-event () - "Test that interrupting a process on MS-Windows sends the - \"interrupt\" event to the process sentinel." + "Test that interrupting a process on Windows sends \"interrupt\" to sentinel." (skip-unless (eq system-type 'windows-nt)) (with-temp-buffer (let* ((proc-buf (current-buffer)) From f95266ee68ab85f7a237b473f98b36413b542553 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 20:50:57 +0200 Subject: [PATCH 026/297] ; Fix byte-compilation warning * test/src/process-tests.el (process-sentinel-interrupt-event): Fix byte compilation warning. --- test/src/process-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index b2e0ec19de1..e62bcb3f7c0 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -893,7 +893,7 @@ Return nil if FILENAME doesn't exist." ;; Capture any incoming events. (set-process-sentinel proc - (lambda (proc event) + (lambda (_prc event) (push event events))) ;; Wait for the process to start. (sleep-for 2) From 83983b6b7a115474572973b62eb5e42251713e63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 6 Feb 2021 18:34:45 +0100 Subject: [PATCH 027/297] Constprop of lexical variables Lexical variables bound to a constant value (symbol, number or string) are substituted at their point of use and the variable then eliminated if possible. Example: (let ((x (+ 2 3))) (f x)) => (f 5) This reduces code size, eliminates stack operations, and enables further optimisations. The implementation is conservative, and is strongly curtailed by the presence of variable mutation, conditions and loops. * lisp/emacs-lisp/byte-opt.el (byte-optimize-enable-variable-constprop) (byte-optimize-warn-eliminated-variable): New constants. (byte-optimize--lexvars, byte-optimize--vars-outside-condition) (byte-optimize--vars-outside-loop, byte-optimize--dynamic-vars): New dynamic variables. (byte-optimize--substitutable-p, byte-optimize-let-form): New functions. (byte-optimize-form-code-walker): Adapt clauses for variable constprop, and add clauses for 'setq' and 'defvar'. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-var) (bytecomp-test-get-var, bytecomp-test-identity) (byte-opt-testsuite-arith-data): Add test cases. --- lisp/emacs-lisp/byte-opt.el | 312 +++++++++++++++++++------ test/lisp/emacs-lisp/bytecomp-tests.el | 61 ++++- 2 files changed, 303 insertions(+), 70 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 66a117fccc8..017cad900d8 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -368,6 +368,53 @@ ;;; implementing source-level optimizers +(defconst byte-optimize-enable-variable-constprop t + "If non-nil, enable constant propagation through local variables.") + +(defconst byte-optimize-warn-eliminated-variable nil + "Whether to warn when a variable is optimised away entirely. +This does usually not indicate a problem and makes the compiler +very chatty, but can be useful for debugging.") + +(defvar byte-optimize--lexvars nil + "Lexical variables in scope, in reverse order of declaration. +Each element is on the form (NAME CHANGED [VALUE]), where: + NAME is the variable name, + CHANGED is a boolean indicating whether it's been changed (with setq), + VALUE, if present, is a substitutable expression. +Earlier variables shadow later ones with the same name.") + +(defvar byte-optimize--vars-outside-condition nil + "Alist of variables lexically bound outside conditionally executed code. +Variables here are sensitive to mutation inside the condition, since such +changes may not be effective for all code paths. +Same format as `byte-optimize--lexvars', with shared structure and contents.") + +(defvar byte-optimize--vars-outside-loop nil + "Alist of variables lexically bound outside the innermost `while' loop. +Variables here are sensitive to mutation inside the loop, since this can +occur an indeterminate number of times and thus have effect on code +sequentially preceding the mutation itself. +Same format as `byte-optimize--lexvars', with shared structure and contents.") + +(defvar byte-optimize--dynamic-vars nil + "List of variables declared as dynamic during optimisation.") + +(defun byte-optimize--substitutable-p (expr) + "Whether EXPR is a constant that can be propagated." + ;; Only consider numbers, symbols and strings to be values for substitution + ;; purposes. Numbers and symbols are immutable, and mutating string + ;; literals (or results from constant-evaluated string-returning functions) + ;; can be considered undefined. + ;; (What about other quoted values, like conses?) + (or (booleanp expr) + (numberp expr) + (stringp expr) + (and (consp expr) + (eq (car expr) 'quote) + (symbolp (cadr expr))) + (keywordp expr))) + (defun byte-optimize-form-code-walker (form for-effect) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But @@ -382,11 +429,24 @@ (let ((fn (car-safe form))) (pcase form ((pred (not consp)) - (if (not (and for-effect - (or byte-compile-delete-errors - (not (symbolp form)) - (eq form t)))) - form)) + (cond + ((and for-effect + (or byte-compile-delete-errors + (not (symbolp form)) + (eq form t))) + nil) + ((symbolp form) + (let ((lexvar (assq form byte-optimize--lexvars))) + (if (cddr lexvar) ; Value available? + (if (assq form byte-optimize--vars-outside-loop) + ;; Cannot substitute; mark as changed to avoid the + ;; variable being eliminated. + (progn + (setcar (cdr lexvar) t) + form) + (caddr lexvar)) ; variable value to use + form))) + (t form))) (`(quote . ,v) (if (cdr v) (byte-compile-warn "malformed quote form: `%s'" @@ -396,33 +456,22 @@ (and (car v) (not for-effect) form)) - (`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare)) - ;; Recursively enter the optimizer for the bindings and body - ;; of a let or let*. This for depth-firstness: forms that - ;; are more deeply nested are optimized first. - (cons fn - (cons - (mapcar (lambda (binding) - (if (symbolp binding) - binding - (if (cdr (cdr binding)) - (byte-compile-warn "malformed let binding: `%s'" - (prin1-to-string binding))) - (list (car binding) - (byte-optimize-form (nth 1 binding) nil)))) - bindings) - (byte-optimize-body exps for-effect)))) + (`(,(or 'let 'let*) . ,rest) + (cons fn (byte-optimize-let-form fn rest for-effect))) (`(cond . ,clauses) - (cons fn - (mapcar (lambda (clause) - (if (consp clause) - (cons - (byte-optimize-form (car clause) nil) - (byte-optimize-body (cdr clause) for-effect)) - (byte-compile-warn "malformed cond form: `%s'" - (prin1-to-string clause)) - clause)) - clauses))) + ;; The condition in the first clause is always executed, but + ;; right now we treat all of them as conditional for simplicity. + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + (cons fn + (mapcar (lambda (clause) + (if (consp clause) + (cons + (byte-optimize-form (car clause) nil) + (byte-optimize-body (cdr clause) for-effect)) + (byte-compile-warn "malformed cond form: `%s'" + (prin1-to-string clause)) + clause)) + clauses)))) (`(progn . ,exps) ;; As an extra added bonus, this simplifies (progn ) --> . (if (cdr exps) @@ -442,35 +491,54 @@ (cons fn (byte-optimize-body exps for-effect))) (`(if ,test ,then . ,else) - `(if ,(byte-optimize-form test nil) - ,(byte-optimize-form then for-effect) - . ,(byte-optimize-body else for-effect))) + ;; The test is always executed. + (let* ((test-opt (byte-optimize-form test nil)) + ;; The THEN and ELSE branches are executed conditionally. + ;; + ;; FIXME: We are conservative here: any variable changed in the + ;; THEN branch will be barred from substitution in the ELSE + ;; branch, despite the branches being mutually exclusive. + (byte-optimize--vars-outside-condition byte-optimize--lexvars) + (then-opt (byte-optimize-form then for-effect)) + (else-opt (byte-optimize-body else for-effect))) + `(if ,test-opt ,then-opt . ,else-opt))) (`(if . ,_) (byte-compile-warn "too few arguments for `if'")) (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. - ;; Take forms off the back until we can't any more. - ;; In the future it could conceivably be a problem that the - ;; subexpressions of these forms are optimized in the reverse - ;; order, but it's ok for now. - (if for-effect - (let ((backwards (reverse exps))) - (while (and backwards - (null (setcar backwards - (byte-optimize-form (car backwards) - for-effect)))) - (setq backwards (cdr backwards))) - (if (and exps (null backwards)) - (byte-compile-log - " all subforms of %s called for effect; deleted" form)) - (and backwards - (cons fn (nreverse (mapcar #'byte-optimize-form - backwards))))) - (cons fn (mapcar #'byte-optimize-form exps)))) + ;; FIXME: We have to traverse the expressions in left-to-right + ;; order, but doing so we miss some optimisation opportunities: + ;; consider (and A B) in a for-effect context, where B => nil. + ;; Then A could be optimised in a for-effect context too. + (let ((tail exps) + (args nil)) + (when tail + ;; The first argument is always unconditional. + (push (byte-optimize-form + (car tail) (and for-effect (null (cdr tail)))) + args) + (setq tail (cdr tail)) + ;; Remaining arguments are conditional. + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + (while tail + (push (byte-optimize-form + (car tail) (and for-effect (null (cdr tail)))) + args) + (setq tail (cdr tail))))) + (cons fn (nreverse args)))) (`(while ,exp . ,exps) - `(while ,(byte-optimize-form exp nil) - . ,(byte-optimize-body exps t))) + ;; FIXME: We conservatively prevent the substitution of any variable + ;; bound outside the loop in case it is mutated later in the loop, + ;; but this misses many opportunities: variables not mutated in the + ;; loop at all, and variables affecting the initial condition (which + ;; is always executed unconditionally). + (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) + (byte-optimize--vars-outside-loop byte-optimize--lexvars) + (condition (byte-optimize-form exp nil)) + (body (byte-optimize-body exps t))) + `(while ,condition . ,body))) + (`(while . ,_) (byte-compile-warn "too few arguments for `while'")) @@ -485,24 +553,35 @@ form) (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare)) - `(condition-case ,var ;Not evaluated. - ,(byte-optimize-form exp for-effect) - ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) - clauses))) + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + `(condition-case ,var ;Not evaluated. + ,(byte-optimize-form exp for-effect) + ,@(mapcar (lambda (clause) + `(,(car clause) + ,@(byte-optimize-body (cdr clause) for-effect))) + clauses)))) - (`(unwind-protect . ,(or `(,exp . ,exps) pcase--dontcare)) - ;; The "protected" part of an unwind-protect is compiled (and thus - ;; optimized) as a top-level form, so don't do it here. But the - ;; non-protected part has the same for-effect status as the - ;; unwind-protect itself. (The protected part is always for effect, + (`(unwind-protect ,exp . ,exps) + ;; The unwinding part of an unwind-protect is compiled (and thus + ;; optimized) as a top-level form, but run the optimizer for it here + ;; anyway for lexical variable usage and substitution. But the + ;; protected part has the same for-effect status as the + ;; unwind-protect itself. (The unwinding part is always for effect, ;; but that isn't handled properly yet.) - `(unwind-protect ,(byte-optimize-form exp for-effect) . ,exps)) + (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) + (bodyform (byte-optimize-form exp for-effect))) + (pcase exps + (`(:fun-body ,f) + `(unwind-protect ,bodyform + :fun-body ,(byte-optimize-form f nil))) + (_ + `(unwind-protect ,bodyform + . ,(byte-optimize-body exps t)))))) (`(catch . ,(or `(,tag . ,exps) pcase--dontcare)) - `(catch ,(byte-optimize-form tag nil) - . ,(byte-optimize-body exps for-effect))) + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + `(catch ,(byte-optimize-form tag nil) + . ,(byte-optimize-body exps for-effect)))) (`(ignore . ,exps) ;; Don't treat the args to `ignore' as being @@ -512,7 +591,14 @@ `(prog1 nil . ,(mapcar #'byte-optimize-form exps))) ;; Needed as long as we run byte-optimize-form after cconv. - (`(internal-make-closure . ,_) form) + (`(internal-make-closure . ,_) + ;; Look up free vars and mark them as changed, so that they + ;; won't be optimised away. + (dolist (var (caddr form)) + (let ((lexvar (assq var byte-optimize--lexvars))) + (when lexvar + (setcar (cdr lexvar) t)))) + form) (`((lambda . ,_) . ,_) (let ((newform (byte-compile-unfold-lambda form))) @@ -525,6 +611,35 @@ ;; is a *value* and shouldn't appear in the car. (`((closure . ,_) . ,_) form) + (`(setq . ,args) + (let ((var-expr-list nil)) + (while args + (unless (and (consp args) + (symbolp (car args)) (consp (cdr args))) + (byte-compile-warn "malformed setq form: %S" form)) + (let* ((var (car args)) + (expr (cadr args)) + (lexvar (assq var byte-optimize--lexvars)) + (value (byte-optimize-form expr nil))) + (when lexvar + ;; If it's bound outside conditional, invalidate. + (if (assq var byte-optimize--vars-outside-condition) + ;; We are in conditional code and the variable was + ;; bound outside: cancel substitutions. + (setcdr (cdr lexvar) nil) + (setcdr (cdr lexvar) + (and (byte-optimize--substitutable-p value) + (list value)))) + (setcar (cdr lexvar) t)) ; Mark variable as changed. + (push var var-expr-list) + (push value var-expr-list)) + (setq args (cddr args))) + (cons fn (nreverse var-expr-list)))) + + (`(defvar ,(and (pred symbolp) name) . ,_) + (push name byte-optimize--dynamic-vars) + form) + (`(,(pred byte-code-function-p) . ,exps) (cons fn (mapcar #'byte-optimize-form exps))) @@ -582,6 +697,64 @@ new) form))) +(defun byte-optimize-let-form (head form for-effect) + ;; Recursively enter the optimizer for the bindings and body + ;; of a let or let*. This for depth-firstness: forms that + ;; are more deeply nested are optimized first. + (if (and lexical-binding byte-optimize-enable-variable-constprop) + (let* ((byte-optimize--lexvars byte-optimize--lexvars) + (new-lexvars nil) + (let-vars nil)) + (dolist (binding (car form)) + (let (name expr) + (cond ((consp binding) + (setq name (car binding)) + (unless (symbolp name) + (byte-compile-warn "let-bind nonvariable: `%S'" name)) + (setq expr (byte-optimize-form (cadr binding) nil))) + ((symbolp binding) + (setq name binding)) + (t (byte-compile-warn "malformed let binding: `%S'" binding))) + (let* ( + (value (and (byte-optimize--substitutable-p expr) + (list expr))) + (lexical (not (or (and (symbolp name) + (special-variable-p name)) + (memq name byte-compile-bound-variables) + (memq name byte-optimize--dynamic-vars)))) + (lexinfo (and lexical (cons name (cons nil value))))) + (push (cons name (cons expr (cdr lexinfo))) let-vars) + (when lexinfo + (push lexinfo (if (eq head 'let*) + byte-optimize--lexvars + new-lexvars)))))) + (setq byte-optimize--lexvars + (append new-lexvars byte-optimize--lexvars)) + ;; Walk the body expressions, which may mutate some of the records, + ;; and generate new bindings that exclude unused variables. + (let* ((opt-body (byte-optimize-body (cdr form) for-effect)) + (bindings nil)) + (dolist (var let-vars) + ;; VAR is (NAME EXPR [CHANGED [VALUE]]) + (if (and (nthcdr 3 var) (not (nth 2 var))) + (when byte-optimize-warn-eliminated-variable + (byte-compile-warn "eliminating local variable %S" (car var))) + (push (list (nth 0 var) (nth 1 var)) bindings))) + (cons bindings opt-body))) + + ;; With dynamic binding, no substitutions are in effect. + (let ((byte-optimize--lexvars nil)) + (cons + (mapcar (lambda (binding) + (if (symbolp binding) + binding + (when (or (atom binding) (cddr binding)) + (byte-compile-warn "malformed let binding: `%S'" binding)) + (list (car binding) + (byte-optimize-form (nth 1 binding) nil)))) + (car form)) + (byte-optimize-body (cdr form) for-effect))))) + (defun byte-optimize-body (forms all-for-effect) ;; Optimize the cdr of a progn or implicit progn; all forms is a list of @@ -590,6 +763,7 @@ ;; all-for-effect is true. returns a new list of forms. (let ((rest forms) (result nil) + (byte-optimize--dynamic-vars byte-optimize--dynamic-vars) fe new) (while rest (setq fe (or all-for-effect (cdr rest))) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 980b402ca2d..bc623d3efca 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -32,6 +32,15 @@ (require 'bytecomp) ;;; Code: +(defvar bytecomp-test-var nil) + +(defun bytecomp-test-get-var () + bytecomp-test-var) + +(defun bytecomp-test-identity (x) + "Identity, but hidden from some optimisations." + x) + (defconst byte-opt-testsuite-arith-data '( ;; some functional tests @@ -371,7 +380,57 @@ (assoc 'b '((a 1) (b 2) (c 3))) (assoc "b" '(("a" 1) ("b" 2) ("c" 3))) (let ((x '((a 1) (b 2) (c 3)))) (assoc 'c x)) - (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v))))) + (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v)))) + + ;; Constprop test cases + (let ((a 'alpha) (b (concat "be" "ta")) (c nil) (d t) (e :gamma) + (f '(delta epsilon))) + (list a b c d e f)) + + (let ((x 1) (y (+ 3 4))) + (list + (let (q (y x) (z y)) + (if q x (list x y z))))) + + (let* ((x 3) (y (* x 2)) (x (1+ y))) + x) + + (let ((x 1) (bytecomp-test-var 2) (y 3)) + (list x bytecomp-test-var (bytecomp-get-test-var) y)) + + (progn + (defvar d) + (let ((x 'a) (y 'b)) (list x y))) + + (let ((x 2)) + (list x (setq x 13) (setq x (* x 2)) x)) + + (let ((x 'a) (y 'b)) + (setq y x + x (cons 'c y) + y x) + (list x y)) + + (let ((x 3)) + (let ((y x) z) + (setq x 5) + (setq y (+ y 8)) + (setq z (if (bytecomp-test-identity t) + (progn + (setq x (+ x 1)) + (list x y)) + (setq x (+ x 2)) + (list x y))) + (list x y z))) + + (let ((i 1) (s 0) (x 13)) + (while (< i 5) + (setq s (+ s i)) + (setq i (1+ i))) + (list s x i)) + + (let ((x 2)) + (list (or (bytecomp-identity 'a) (setq x 3)) x))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") From 4dc3231c91c339e602f59dcfee372017b92e4318 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 4 Feb 2021 14:32:21 +0100 Subject: [PATCH 028/297] Fix spurious warnings from unwise condition order in inlined code These are both conditions having the form (and A B) where A is side-effect-free and B may be known to be nil at compile time. The compiler will then warn about A being useless and thrown away. The fix is to test B first. * lisp/gnus/gnus.el (gnus-method-to-server): Test `(not no-enter-cache)` first. (gnus-server-get-method): Test `group` first. --- lisp/gnus/gnus.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 84e53da297b..98664ac2b44 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3212,8 +3212,8 @@ that that variable is buffer-local to the summary buffers." (format "%s" (car method)) (format "%s:%s" (car method) (cadr method)))) (name-method (cons name method))) - (when (and (not (member name-method gnus-server-method-cache)) - (not no-enter-cache) + (when (and (not no-enter-cache) + (not (member name-method gnus-server-method-cache)) (not (assoc (car name-method) gnus-server-method-cache))) (push name-method gnus-server-method-cache)) name))) @@ -3273,8 +3273,7 @@ that that variable is buffer-local to the summary buffers." (gnus-server-to-method method)) ((equal method gnus-select-method) gnus-select-method) - ((and (stringp (car method)) - group) + ((and group (stringp (car method))) (gnus-server-extend-method group method)) ((and method (not group) From 06e1e5eeacf67b11490431c3d36700a73cf49d88 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 6 Feb 2021 22:59:00 +0200 Subject: [PATCH 029/297] Revert "Fix the previous change" This reverts commit fc37dc298f27025823fad2d944e11cc7ee6a058d. That change was only needed in the release branch. --- lisp/progmodes/project.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4c9b70ce043..abe563bec04 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -725,7 +725,7 @@ requires quoting, e.g. `\\[quoted-insert]'." (require 'xref) (require 'grep) (let* ((pr (project-current t)) - (default-directory (car (project-roots pr))) + (default-directory (project-root pr)) (files (if (not current-prefix-arg) (project-files pr) @@ -757,7 +757,7 @@ pattern to search for." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) - (default-directory (car (project-roots pr))) + (default-directory (project-root pr)) (files (project-files pr (cons (project-root pr) From 765ffeb54569c1679b9f08b50c6a88fe50c525c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 7 Feb 2021 10:35:36 +0100 Subject: [PATCH 030/297] ; Improved commentary in the variable constprop mechanism * lisp/emacs-lisp/byte-opt.el (byte-optimize--lexvars) (byte-optimize--vars-outside-condition) (byte-optimize-form-code-walker, byte-optimize-let-form): Clarify various aspects in the variable constant-propagation code, as kindly pointed out by Stefan Monnier. --- lisp/emacs-lisp/byte-opt.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 017cad900d8..32f66ebebb9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -378,16 +378,17 @@ very chatty, but can be useful for debugging.") (defvar byte-optimize--lexvars nil "Lexical variables in scope, in reverse order of declaration. -Each element is on the form (NAME CHANGED [VALUE]), where: +Each element is on the form (NAME KEEP [VALUE]), where: NAME is the variable name, - CHANGED is a boolean indicating whether it's been changed (with setq), + KEEP is a boolean indicating whether the binding must be retained, VALUE, if present, is a substitutable expression. Earlier variables shadow later ones with the same name.") (defvar byte-optimize--vars-outside-condition nil "Alist of variables lexically bound outside conditionally executed code. -Variables here are sensitive to mutation inside the condition, since such -changes may not be effective for all code paths. +Variables here are sensitive to mutation inside the conditional code, +since their contents in sequentially later code depends on the path taken +and may no longer be statically known. Same format as `byte-optimize--lexvars', with shared structure and contents.") (defvar byte-optimize--vars-outside-loop nil @@ -507,7 +508,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. ;; FIXME: We have to traverse the expressions in left-to-right - ;; order, but doing so we miss some optimisation opportunities: + ;; order (because that is the order of evaluation and variable + ;; mutations must be found prior to their use), but doing so we miss + ;; some optimisation opportunities: ;; consider (and A B) in a for-effect context, where B => nil. ;; Then A could be optimised in a for-effect context too. (let ((tail exps) @@ -592,7 +595,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; Needed as long as we run byte-optimize-form after cconv. (`(internal-make-closure . ,_) - ;; Look up free vars and mark them as changed, so that they + ;; Look up free vars and mark them to be kept, so that they ;; won't be optimised away. (dolist (var (caddr form)) (let ((lexvar (assq var byte-optimize--lexvars))) @@ -627,10 +630,11 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; We are in conditional code and the variable was ;; bound outside: cancel substitutions. (setcdr (cdr lexvar) nil) + ;; Set a new value (if substitutable). (setcdr (cdr lexvar) (and (byte-optimize--substitutable-p value) (list value)))) - (setcar (cdr lexvar) t)) ; Mark variable as changed. + (setcar (cdr lexvar) t)) ; Mark variable to be kept. (push var var-expr-list) (push value var-expr-list)) (setq args (cddr args))) @@ -735,8 +739,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (let* ((opt-body (byte-optimize-body (cdr form) for-effect)) (bindings nil)) (dolist (var let-vars) - ;; VAR is (NAME EXPR [CHANGED [VALUE]]) + ;; VAR is (NAME EXPR [KEEP [VALUE]]) (if (and (nthcdr 3 var) (not (nth 2 var))) + ;; Value present and not marked to be kept: eliminate. (when byte-optimize-warn-eliminated-variable (byte-compile-warn "eliminating local variable %S" (car var))) (push (list (nth 0 var) (nth 1 var)) bindings))) From 7e48430a43bbf7a2bbe347540dc346d0129df2ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 7 Feb 2021 12:24:40 +0100 Subject: [PATCH 031/297] ; * lisp/emacs-lisp/byte-opt.el: improved comment --- lisp/emacs-lisp/byte-opt.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 32f66ebebb9..abbe2a2e63f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -440,7 +440,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (let ((lexvar (assq form byte-optimize--lexvars))) (if (cddr lexvar) ; Value available? (if (assq form byte-optimize--vars-outside-loop) - ;; Cannot substitute; mark as changed to avoid the + ;; Cannot substitute; mark for retention to avoid the ;; variable being eliminated. (progn (setcar (cdr lexvar) t) From 8b8708eadd94fcdad4c426a20370ff4ab13df258 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Sun, 7 Feb 2021 13:10:19 +0100 Subject: [PATCH 032/297] Fix example in Sequence Functions node in the manual * doc/lispref/sequences.texi (Sequence Functions): Fix the result from the example. --- doc/lispref/sequences.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index bdf0b95d810..b48d4569180 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -594,7 +594,7 @@ returned value is a list. (seq-map-indexed (lambda (elt idx) (list idx elt)) '(a b c)) -@result{} ((0 a) (b 1) (c 2)) +@result{} ((0 a) (1 b) (2 c)) @end group @end example @end defun From a6a5d6a27a86396ab96662fa158cdcc854bd777b Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 7 Feb 2021 13:30:33 +0100 Subject: [PATCH 033/297] Move 'revert-buffer' global binding to 'C-x g g' * lisp/bindings.el: Define ctl-x-g-map and bind 'revert-buffer' to 'C-x x g' globally. * doc/emacs/files.texi: Replace 'C-x g' with 'C-x x g'. * etc/NEWS: Document the change (bug#46300). --- doc/emacs/files.texi | 2 +- etc/NEWS | 2 +- lisp/bindings.el | 7 ++++++- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 12ceac800ef..6b3bc430d97 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -927,7 +927,7 @@ Manual}). For customizations, see the Custom group @code{time-stamp}. If you have made extensive changes to a file-visiting buffer and then change your mind, you can @dfn{revert} the changes and go back to -the saved version of the file. To do this, type @kbd{C-x g}. Since +the saved version of the file. To do this, type @kbd{C-x x g}. Since reverting unintentionally could lose a lot of work, Emacs asks for confirmation first. diff --git a/etc/NEWS b/etc/NEWS index fb776884701..b80c649074e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -234,7 +234,7 @@ still applies for shorter search strings, which avoids flicker in the search buffer due to too many matches being highlighted. +++ -** 'revert-buffer' is now bound to 'C-x g' globally. +** 'revert-buffer' is now bound to 'C-x x g' globally. * Editing Changes in Emacs 28.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index 9ea188d1a00..35adfa8172c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1413,7 +1413,12 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "z" 'repeat) -(define-key ctl-x-map "g" #'revert-buffer) +(defvar ctl-x-x-map + (let ((map (make-sparse-keymap))) + (define-key map "g" #'revert-buffer) + map) + "Keymap for subcommands of C-x x.") +(define-key ctl-x-map "x" ctl-x-x-map) (define-key esc-map "\C-l" 'reposition-window) From e0c9399454838444e0cc8c6c1fc1d307d9e9752b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 13:53:44 +0100 Subject: [PATCH 034/297] Add more commands to the new `C-x x' keymap * doc/emacs/killing.texi (Accumulating Text): * doc/emacs/display.texi (Line Truncation): * doc/emacs/buffers.texi (Misc Buffer): Document it. * lisp/bindings.el (ctl-x-x-map): Add new bindings for rename-buffer, rename-uniquely, insert-buffer and toggle-truncate-lines. --- doc/emacs/buffers.texi | 32 ++++++++++++++++---------------- doc/emacs/display.texi | 14 +++++++------- doc/emacs/killing.texi | 14 +++++++------- etc/NEWS | 6 +++++- lisp/bindings.el | 4 ++++ 5 files changed, 39 insertions(+), 31 deletions(-) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 9cdfa493ed4..3a166e404a8 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -232,9 +232,9 @@ unless they visit files: such buffers are used internally by Emacs. @table @kbd @item C-x C-q Toggle read-only status of buffer (@code{read-only-mode}). -@item M-x rename-buffer @key{RET} @var{buffer} @key{RET} +@item C-x x r @key{RET} @var{buffer} @key{RET} Change the name of the current buffer. -@item M-x rename-uniquely +@item C-x x u Rename the current buffer by adding @samp{<@var{number}>} to the end. @item M-x view-buffer @key{RET} @var{buffer} @key{RET} Scroll through buffer @var{buffer}. @xref{View Mode}. @@ -263,28 +263,28 @@ non-@code{nil} value, making the buffer read-only with @kbd{C-x C-q} also enables View mode in the buffer (@pxref{View Mode}). @findex rename-buffer - @kbd{M-x rename-buffer} changes the name of the current buffer. You -specify the new name as a minibuffer argument; there is no default. -If you specify a name that is in use for some other buffer, an error -happens and no renaming is done. + @kbd{C-x x r} (@code{rename-buffer} changes the name of the current +buffer. You specify the new name as a minibuffer argument; there is +no default. If you specify a name that is in use for some other +buffer, an error happens and no renaming is done. @findex rename-uniquely - @kbd{M-x rename-uniquely} renames the current buffer to a similar -name with a numeric suffix added to make it both different and unique. -This command does not need an argument. It is useful for creating -multiple shell buffers: if you rename the @file{*shell*} buffer, then -do @kbd{M-x shell} again, it makes a new shell buffer named -@file{*shell*}; meanwhile, the old shell buffer continues to exist -under its new name. This method is also good for mail buffers, + @kbd{C-x x u} (@code{rename-uniquely}) renames the current buffer to +a similar name with a numeric suffix added to make it both different +and unique. This command does not need an argument. It is useful for +creating multiple shell buffers: if you rename the @file{*shell*} +buffer, then do @kbd{M-x shell} again, it makes a new shell buffer +named @file{*shell*}; meanwhile, the old shell buffer continues to +exist under its new name. This method is also good for mail buffers, compilation buffers, and most Emacs features that create special buffers with particular names. (With some of these features, such as @kbd{M-x compile}, @kbd{M-x grep}, you need to switch to some other buffer before using the command again, otherwise it will reuse the current buffer despite the name change.) - The commands @kbd{M-x append-to-buffer} and @kbd{M-x insert-buffer} -can also be used to copy text from one buffer to another. -@xref{Accumulating Text}. + The commands @kbd{M-x append-to-buffer} and @kbd{C-x x i} +(@code{insert-buffer}) can also be used to copy text from one buffer +to another. @xref{Accumulating Text}. @node Kill Buffer @section Killing Buffers diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index f4b18541429..2781328cb7d 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1755,13 +1755,13 @@ and/or leftmost columns. @findex toggle-truncate-lines Horizontal scrolling automatically causes line truncation (@pxref{Horizontal Scrolling}). You can explicitly enable line -truncation for a particular buffer with the command @kbd{M-x -toggle-truncate-lines}. This works by locally changing the variable -@code{truncate-lines}. If that variable is non-@code{nil}, long lines -are truncated; if it is @code{nil}, they are continued onto multiple -screen lines. Setting the variable @code{truncate-lines} in any way -makes it local to the current buffer; until that time, the default -value, which is normally @code{nil}, is in effect. +truncation for a particular buffer with the command @kbd{C-x x t} +(@code{toggle-truncate-lines}). This works by locally changing the +variable @code{truncate-lines}. If that variable is non-@code{nil}, +long lines are truncated; if it is @code{nil}, they are continued onto +multiple screen lines. Setting the variable @code{truncate-lines} in +any way makes it local to the current buffer; until that time, the +default value, which is normally @code{nil}, is in effect. If a split window becomes too narrow, Emacs may automatically enable line truncation. @xref{Split Window}, for the variable diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 9bc786dc47b..8434040bcea 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -703,13 +703,13 @@ copy-to-buffer} is similar, except that any existing text in the other buffer is deleted, so the buffer is left containing just the text newly copied into it. - The command @kbd{M-x insert-buffer} can be used to retrieve the -accumulated text from another buffer. This prompts for the name of a -buffer, and inserts a copy of all the text in that buffer into the -current buffer at point, leaving point at the beginning of the -inserted text. It also adds the position of the end of the inserted -text to the mark ring, without activating the mark. @xref{Buffers}, -for background information on buffers. + The command @kbd{C-x x i} (@code{insert-buffer}) can be used to +retrieve the accumulated text from another buffer. This prompts for +the name of a buffer, and inserts a copy of all the text in that +buffer into the current buffer at point, leaving point at the +beginning of the inserted text. It also adds the position of the end +of the inserted text to the mark ring, without activating the mark. +@xref{Buffers}, for background information on buffers. Instead of accumulating text in a buffer, you can append text directly into a file with @kbd{M-x append-to-file}. This prompts for diff --git a/etc/NEWS b/etc/NEWS index b80c649074e..0faed3e5aa2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -234,7 +234,11 @@ still applies for shorter search strings, which avoids flicker in the search buffer due to too many matches being highlighted. +++ -** 'revert-buffer' is now bound to 'C-x x g' globally. +** A new keymap for buffer actions has been added. +The 'C-x x' keymap now holds keystrokes for various buffer-oriented +commands. The new keystrokes are 'C-x x g' ('revert-buffer'), +'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), +'C-x x i' ('insert-buffer') and 'C-x x t' ('toggle-truncate-lines'). * Editing Changes in Emacs 28.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index 35adfa8172c..9462468b1b0 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1416,6 +1416,10 @@ if `inhibit-field-text-motion' is non-nil." (defvar ctl-x-x-map (let ((map (make-sparse-keymap))) (define-key map "g" #'revert-buffer) + (define-key map "r" #'rename-buffer) + (define-key map "u" #'rename-uniquely) + (define-key map "i" #'insert-buffer) + (define-key map "t" #'toggle-truncate-lines) map) "Keymap for subcommands of C-x x.") (define-key ctl-x-map "x" ctl-x-x-map) From a1a31ecb4027a831eb81728bf66fbd44a28d2840 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 14:47:09 +0100 Subject: [PATCH 035/297] Clarify that #s(hash-table ...) doesn't always create a new hash table * doc/lispref/hash.texi (Creating Hash): Note that the printed representation doesn't necessarily create a new table (bug#23417). * doc/lispref/lists.texi (Rearrangement): Link to Self-Evaluating Forms to further expand upon immutability. --- doc/lispref/hash.texi | 9 +++++++-- doc/lispref/lists.texi | 13 +++++++------ 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 8781fad30cd..12c6a659079 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -150,11 +150,11 @@ multiplied by an approximation to this value. The default for @end table @end defun -You can also create a new hash table using the printed representation +You can also create a hash table using the printed representation for hash tables. The Lisp reader can read this printed representation, provided each element in the specified hash table has a valid read syntax (@pxref{Printed Representation}). For instance, -the following specifies a new hash table containing the keys +the following specifies a hash table containing the keys @code{key1} and @code{key2} (both symbols) associated with @code{val1} (a symbol) and @code{300} (a number) respectively. @@ -162,6 +162,11 @@ the following specifies a new hash table containing the keys #s(hash-table size 30 data (key1 val1 key2 300)) @end example +Note, however, that when using this in Emacs Lisp code, it's +undefined whether this creates a new hash table or not. If you want +to create a new hash table, you should always use +@code{make-hash-table} (@pxref{Self-Evaluating Forms}). + @noindent The printed representation for a hash table consists of @samp{#s} followed by a list beginning with @samp{hash-table}. The rest of the diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index c54496f6168..2805b1f5fdc 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1168,13 +1168,14 @@ x @end group @end example -However, the other arguments (all but the last) should be mutable lists. +However, the other arguments (all but the last) should be mutable +lists. -A common pitfall is to use a constant list as a non-last -argument to @code{nconc}. If you do this, the resulting behavior -is undefined. It is possible that your program will change -each time you run it! Here is what might happen (though this -is not guaranteed to happen): +A common pitfall is to use a constant list as a non-last argument to +@code{nconc}. If you do this, the resulting behavior is undefined +(@pxref{Self-Evaluating Forms}). It is possible that your program +will change each time you run it! Here is what might happen (though +this is not guaranteed to happen): @smallexample @group From 5beddcd325e8ec16a6f284ef0524fb796fe07d5e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 15:07:21 +0100 Subject: [PATCH 036/297] Reverse customize-changed and customize-changed-options aliasing * lisp/cus-edit.el (customize-changed): Rename from customize-changed-options (bug#23085), since the old name doesn't reflect what it does: It's not just about user options, but also faces and the like. (customize-changed-options): Make into an obsolete alias. --- lisp/cus-edit.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index e52df4e6a2c..cd1ae964eb9 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1242,10 +1242,11 @@ the user might see the value in an error message, a good choice is the official name of the package, such as MH-E or Gnus.") ;;;###autoload -(defalias 'customize-changed 'customize-changed-options) +(define-obsolete-function-alias 'customize-changed-options + #'customize-changed "28.1") ;;;###autoload -(defun customize-changed-options (&optional since-version) +(defun customize-changed (&optional since-version) "Customize all settings whose meanings have changed in Emacs itself. This includes new user options and faces, and new customization groups, as well as older options and faces whose meanings or From 5ffc55d1e98d04b035c3d8d88d678b74af7a1fd7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 15:12:15 +0100 Subject: [PATCH 037/297] Revert "Fix inferior octave single-quote font lock" This reverts commit 9e68413c7f0a7f71e1cee923ace7282d14c2e686. This patch led to bug#46327: x = [2 2]' disp(x) Which meant that the transpose operator was interpreted as the start of a string. --- lisp/progmodes/octave.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index cb44b72fb44..ddcc6f5450e 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -165,7 +165,7 @@ parenthetical grouping.") (modify-syntax-entry ?| "." table) (modify-syntax-entry ?! "." table) (modify-syntax-entry ?\\ "." table) - (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?\' "." table) (modify-syntax-entry ?\` "." table) (modify-syntax-entry ?. "." table) (modify-syntax-entry ?\" "\"" table) From 4e8d36fdaadade020f0bcadc70d617d8b07b739c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Feb 2021 15:53:46 +0100 Subject: [PATCH 038/297] Various doc fixes in dictionary.el * lisp/net/dictionary.el (dictionary-set-server-var) (dictionary-server, dictionary-port) (dictionary-default-dictionary) (dictionary-default-popup-strategy, dictionary-proxy-server) (dictionary-proxy-port, dictionary-description-open-delimiter) (dictionary-description-close-delimiter) (dictionary-window-configuration, dictionary-selected-window) (dictionary-position-stack, dictionary-data-stack) (dictionary-positions, dictionary-current-data) (dictionary-connection, dictionary-instances) (dictionary-color-support, dictionary-word-history) (dictionary-mode, dictionary, dictionary-check-connection) (dictionary-mode-p, dictionary-send-command) (dictionary-read-reply-and-split, dictionary-check-reply) (dictionary-check-initial-reply, dictionary-store-state) (dictionary-store-positions, dictionary-new-search) (dictionary-new-search-internal, dictionary-do-search) (dictionary-display-search-result) (dictionary-display-word-definition) (dictionary-special-dictionary, dictionary-set-strategy) (dictionary-tooltip-dictionary, dictionary-switch-tooltip-mode) (dictionary-tooltip-mode, global-dictionary-tooltip-mode): Doc fixes to adhere to our conventions. --- lisp/net/dictionary.el | 124 +++++++++++++++++++---------------------- 1 file changed, 58 insertions(+), 66 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index f8733429e94..7af8cdc59b2 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -46,7 +46,7 @@ (defun dictionary-set-server-var (name value) "Customize helper for setting variable NAME to VALUE. The helper is used by customize to check for an active connection -when setting a variable. The user has then the choice to close +when setting a variable. The user has then the choice to close the existing connection." (if (and (boundp 'dictionary-connection) dictionary-connection @@ -73,8 +73,7 @@ You can specify here: - Automatic: First try localhost, then dict.org after confirmation - localhost: Only use localhost - dict.org: Only use dict.org -- User-defined: You can specify your own server here -" +- User-defined: You can specify your own server here" :group 'dictionary :set 'dictionary-set-server-var :type '(choice (const :tag "Automatic" nil) @@ -86,7 +85,7 @@ You can specify here: (defcustom dictionary-port 2628 "The port of the dictionary server. - This port is propably always 2628 so there should be no need to modify it." +This port is propably always 2628 so there should be no need to modify it." :group 'dictionary :set 'dictionary-set-server-var :type 'number @@ -102,8 +101,8 @@ You can specify here: (defcustom dictionary-default-dictionary "*" "The dictionary which is used for searching definitions and matching. - * and ! have a special meaning, * search all dictionaries, ! search until - one dictionary yields matches." +* and ! have a special meaning, * search all dictionaries, ! search until +one dictionary yields matches." :group 'dictionary :type 'string :version "28.1") @@ -144,8 +143,7 @@ by the choice value: - User choice Here you can enter any matching algorithm supported by your - dictionary server. -" + dictionary server." :group 'dictionary :type '(choice (const :tag "Exact match" "exact") (const :tag "Similiar sounding" "soundex") @@ -177,7 +175,7 @@ by the choice value: (defcustom dictionary-proxy-server "proxy" - "The name of the HTTP proxy to use when dictionary-use-http-proxy is set." + "The name of the HTTP proxy to use when `dictionary-use-http-proxy' is set." :group 'dictionary-proxy :set 'dictionary-set-server-var :type 'string @@ -185,7 +183,7 @@ by the choice value: (defcustom dictionary-proxy-port 3128 - "The port of the proxy server, used only when dictionary-use-http-proxy is set." + "The port of the proxy server, used only when `dictionary-use-http-proxy' is set." :group 'dictionary-proxy :set 'dictionary-set-server-var :type 'number @@ -200,14 +198,14 @@ by the choice value: (defcustom dictionary-description-open-delimiter "" - "The delimiter to display in front of the dictionaries description" + "The delimiter to display in front of the dictionaries description." :group 'dictionary :type 'string :version "28.1") (defcustom dictionary-description-close-delimiter "" - "The delimiter to display after of the dictionaries description" + "The delimiter to display after of the dictionaries description." :group 'dictionary :type 'string :version "28.1") @@ -283,27 +281,27 @@ is utf-8" (defvar dictionary-window-configuration nil - "The window configuration to be restored upon closing the buffer") + "The window configuration to be restored upon closing the buffer.") (defvar dictionary-selected-window nil - "The currently selected window") + "The currently selected window.") (defvar dictionary-position-stack nil - "The history buffer for point and window position") + "The history buffer for point and window position.") (defvar dictionary-data-stack nil - "The history buffer for functions and arguments") + "The history buffer for functions and arguments.") (defvar dictionary-positions nil - "The current positions") + "The current positions.") (defvar dictionary-current-data nil - "The item that will be placed on stack next time") + "The item that will be placed on stack next time.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Global variables @@ -330,11 +328,11 @@ is utf-8" (defvar dictionary-connection nil - "The current network connection") + "The current network connection.") (defvar dictionary-instances 0 - "The number of open dictionary buffers") + "The number of open dictionary buffers.") (defvar dictionary-marker nil @@ -344,11 +342,11 @@ is utf-8" (condition-case nil (x-display-color-p) (error nil)) - "Determines if the Emacs has support to display color") + "Determines if the Emacs has support to display color.") (defvar dictionary-word-history '() - "History list of searched word") + "History list of searched word.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic function providing startup actions @@ -356,25 +354,25 @@ is utf-8" ;;;###autoload (defun dictionary-mode () + ;; FIXME: Use define-derived-mode. "Mode for searching a dictionary. This is a mode for searching a dictionary server implementing the protocol defined in RFC 2229. This is a quick reference to this mode describing the default key bindings: +\\ +* \\[dictionary-close] close the dictionary buffer +* \\[dictionary-help] display this help information +* \\[dictionary-search] ask for a new word to search +* \\[dictionary-lookup-definition] search the word at point +* \\[forward-button] or TAB place point to the next link +* \\[backward-button] or S-TAB place point to the prev link -* q close the dictionary buffer -* h display this help information -* s ask for a new word to search -* d search the word at point -* n or Tab place point to the next link -* p or S-Tab place point to the prev link +* \\[dictionary-match-words] ask for a pattern and list all matching words. +* \\[dictionary-select-dictionary] select the default dictionary +* \\[dictionary-select-strategy] select the default search strategy -* m ask for a pattern and list all matching words. -* D select the default dictionary -* M select the default search strategy - -* Return or Button2 visit that link -" +* RET or visit that link" (unless (eq major-mode 'dictionary-mode) (cl-incf dictionary-instances)) @@ -399,7 +397,7 @@ This is a quick reference to this mode describing the default key bindings: ;;;###autoload (defun dictionary () - "Create a new dictonary buffer and install dictionary-mode." + "Create a new dictonary buffer and install `dictionary-mode'." (interactive) (let ((buffer (or (and dictionary-use-single-buffer (get-buffer "*Dictionary*")) @@ -498,13 +496,13 @@ The connection takes the proxy setting in customization group (dictionary-open-server server) (error (if (y-or-n-p - (format "Failed to open server %s, continue with dict.org?" + (format "Failed to open server %s, continue with dict.org? " server)) (dictionary-open-server "dict.org") (error "Failed automatic server selection, please customize dictionary-server")))))))) (defun dictionary-mode-p () - "Return non-nil if current buffer has dictionary-mode." + "Return non-nil if current buffer has `dictionary-mode'." (eq major-mode 'dictionary-mode)) (defun dictionary-ensure-buffer () @@ -535,7 +533,7 @@ The connection takes the proxy setting in customization group ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-send-command (string) - "Send the command `string' to the network connection." + "Send the command STRING to the network connection." (dictionary-check-connection) ;;;; ##### (dictionary-connection-send-crlf dictionary-connection string)) @@ -566,7 +564,7 @@ This function knows about the special meaning of quotes (\")" (nreverse list))) (defun dictionary-read-reply-and-split () - "Reads the reply, splits it into words and returns it." + "Read the reply, split it into words and return it." (let ((answer (make-symbol "reply-data")) (reply (dictionary-read-reply))) (let ((reply-list (dictionary-split-string reply))) @@ -589,7 +587,7 @@ The answer is delimited by a decimal point (.) on a line by itself." answer)) (defun dictionary-check-reply (reply code) - "Extract the reply code from REPLY and checks against CODE." + "Extract the reply code from REPLY and check against CODE." (let ((number (dictionary-reply-code reply))) (and (numberp number) (= number code)))) @@ -623,7 +621,7 @@ The answer is delimited by a decimal point (.) on a line by itself." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-check-initial-reply () - "Reads the first reply from server and checks it." + "Read the first reply from server and check it." (let ((reply (dictionary-read-reply-and-split))) (unless (dictionary-check-reply reply 220) (dictionary-connection-close dictionary-connection) @@ -631,9 +629,9 @@ The answer is delimited by a decimal point (.) on a line by itself." ;; Store the current state (defun dictionary-store-state (function data) - "Stores the current state of operation for later restore. -The current state consist of a tuple of FUNCTION and DATA. This -is basically an implementation of a history to return to a + "Store the current state of operation for later restore. +The current state consist of a tuple of FUNCTION and DATA. +This is basically an implementation of a history to return to a previous state." (if dictionary-current-data (progn @@ -645,7 +643,7 @@ previous state." (cons function data))) (defun dictionary-store-positions () - "Stores the current positions for later restore." + "Store the current positions for later restore." (setq dictionary-positions (cons (point) (window-start)))) @@ -664,7 +662,7 @@ previous state." ;; The normal search (defun dictionary-new-search (args &optional all) - "Saves the current state and starts a new search based on ARGS. + "Save the current state and start a new search based on ARGS. The parameter ARGS is a cons cell where car is the word to search and cdr is the dictionary where to search the word in." (interactive) @@ -680,15 +678,14 @@ and cdr is the dictionary where to search the word in." (list word dictionary 'dictionary-display-search-result)))) (defun dictionary-new-search-internal (word dictionary function) - "Starts a new search for WORD in DICTIONARY after preparing the buffer. -FUNCTION is the callback which is called for each search result. -" + "Start a new search for WORD in DICTIONARY after preparing the buffer. +FUNCTION is the callback which is called for each search result." (dictionary-pre-buffer) (dictionary-do-search word dictionary function)) (defun dictionary-do-search (word dictionary function &optional nomatching) - "Searches WORD in DICTIONARY and calls FUNCTION for each result. -The parameter NOMATCHING controls whether to suppress the display + "Search for WORD in DICTIONARY and call FUNCTION for each result. +Optional argument NOMATCHING controls whether to suppress the display of matching words." (message "Searching for %s in %s" word dictionary) @@ -712,7 +709,7 @@ of matching words." 'dictionary-display-only-match-result) (dictionary-post-buffer))) (if (dictionary-check-reply reply 550) - (error "Dictionary \"%s\" is unknown, please select an existing one." + (error "Dictionary \"%s\" is unknown, please select an existing one" dictionary) (unless (dictionary-check-reply reply 150) (error "Unknown server answer: %s" (dictionary-reply reply))) @@ -776,7 +773,7 @@ of matching words." (setq buffer-read-only t)) (defun dictionary-display-search-result (reply) - "This function starts displaying the result in REPLY." + "Start displaying the result in REPLY." (let ((number (nth 1 (dictionary-reply-list reply)))) (insert number (if (equal number "1") @@ -810,8 +807,7 @@ The DICTIONARY is only used for decoding the bytes to display the DESCRIPTION." (defun dictionary-display-word-definition (reply word dictionary) "Insert the definition in REPLY for the current WORD from DICTIONARY. It will replace links which are found in the REPLY and replace -them with buttons to perform a a new search. -" +them with buttons to perform a a new search." (let ((start (point))) (insert (dictionary-decode-charset reply dictionary)) (insert "\n\n") @@ -931,7 +927,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (message "Dictionary %s has been selected" dictionary)))) (defun dictionary-special-dictionary (name) - "Checks whether the special * or ! dictionary are seen in NAME." + "Check whether the special * or ! dictionary are seen in NAME." (or (equal name "*") (equal name "!"))) @@ -1011,7 +1007,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) - "Select this STRATEGY as new default" + "Select this STRATEGY as new default." (setq dictionary-default-strategy strategy) (dictionary-restore-state) (message "Strategy %s has been selected" strategy)) @@ -1234,7 +1230,7 @@ allows editing it." (defcustom dictionary-tooltip-dictionary nil - "This dictionary to lookup words for tooltips" + "This dictionary to lookup words for tooltips." :group 'dictionary :type '(choice (const :tag "None" nil) string) :version "28.1") @@ -1296,8 +1292,7 @@ It is normally internally called with 1 to enable support for the tooltip mode. The hook function will check the value of the variable dictionary-tooltip-mode to decide if some action must be taken. When disabling the tooltip mode the value of this variable -will be set to nil. -" +will be set to nil." (interactive) (tooltip-mode on) (if on @@ -1309,10 +1304,8 @@ will be set to nil. "Display tooltips for the current word. This function can be used to enable or disable the tooltip mode -for the current buffer (based on ARG). If global-tooltip-mode is -active it will overwrite that mode for the current buffer. -" - +for the current buffer (based on ARG). If global-tooltip-mode is +active it will overwrite that mode for the current buffer." (interactive "P") (require 'tooltip) (let ((on (if arg @@ -1335,8 +1328,7 @@ Internally it provides a default for the dictionary-tooltip-mode. It can be overwritten for each buffer using dictionary-tooltip-mode. Note: (global-dictionary-tooltip-mode 0) will not disable the mode -any buffer where (dictionary-tooltip-mode 1) has been called. -" +any buffer where (dictionary-tooltip-mode 1) has been called." (interactive "P") (require 'tooltip) (let ((on (if arg (> (prefix-numeric-value arg) 0) From 094a109b8eefbabbc99dba925ebec9887c101a91 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 16:02:56 +0100 Subject: [PATCH 039/297] Add a new function 'line-number-at-position' * doc/lispref/positions.texi (Text Lines): Document it. * lisp/simple.el (count-lines): Use it. (line-number-at-pos): Ditto. * src/fns.c (Fline_number_at_position): New function (bug#22763). --- doc/lispref/positions.texi | 18 ++++++++++-------- etc/NEWS | 4 ++++ lisp/simple.el | 17 ++++++----------- src/fns.c | 18 ++++++++++++++++++ test/src/fns-tests.el | 8 ++++++++ 5 files changed, 46 insertions(+), 19 deletions(-) diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index dc0c7442d8d..9adce21baec 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -437,16 +437,18 @@ prints a message reporting the number of lines, words, and characters in the buffer, or in the region if the region is active. @end deffn +@defun line-number-at-position pos +This function returns the line number in the current buffer +corresponding to the buffer position @var{pos}. If narrowing is in +effect, this is the line number in the visible part of the buffer. +@end defun + @defun line-number-at-pos &optional pos absolute @cindex line number -This function returns the line number in the current buffer -corresponding to the buffer position @var{pos}. If @var{pos} is -@code{nil} or omitted, the current buffer position is used. If -@var{absolute} is @code{nil}, the default, counting starts at -@code{(point-min)}, so the value refers to the contents of the -accessible portion of the (potentially narrowed) buffer. If -@var{absolute} is non-@code{nil}, ignore any narrowing and return -the absolute line number. +This function is like @code{line-number-at-position}, but if @var{pos} +is @code{nil} or omitted, the current buffer position is used. In +addition, if @var{absolute} is non-@code{nil}, ignore any narrowing +and return the absolute line number. @end defun @ignore diff --git a/etc/NEWS b/etc/NEWS index 0faed3e5aa2..93a60bf14cf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2192,6 +2192,10 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 ++++ +** New function 'line-number-at-position'. +This returns the line number in the visible portion of the buffer. + --- ** New variable 'indent-line-ignored-functions'. This allows modes to cycle through a set of indentation functions diff --git a/lisp/simple.el b/lisp/simple.el index e4a363a9a59..eab2ac25691 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1472,7 +1472,7 @@ included in the count." (assq prop buffer-invisibility-spec))) (setq invisible-count (1+ invisible-count)))) invisible-count)))) - (t (- (buffer-size) (forward-line (buffer-size)))))))) + (t (1- (line-number-at-position (point-max)))))))) (defun line-number-at-pos (&optional pos absolute) "Return buffer line number at position POS. @@ -1483,16 +1483,11 @@ at (point-min), so the value refers to the contents of the accessible portion of the (potentially narrowed) buffer. If ABSOLUTE is non-nil, ignore any narrowing and return the absolute line number." - (save-restriction - (when absolute - (widen)) - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point))))))) + (if absolute + (save-restriction + (widen) + (line-number-at-position (or pos (point)))) + (line-number-at-position (or pos (point))))) (defcustom what-cursor-show-names nil "Whether to show character names in `what-cursor-position'." diff --git a/src/fns.c b/src/fns.c index bd4afa0c4e9..479a5975ce7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5758,6 +5758,23 @@ in OBJECT. */) traverse_intervals (intervals, 0, collect_interval, collector); return CDR (collector); } + +DEFUN ("line-number-at-position", Fline_number_at_position, + Sline_number_at_position, 1, 1, 0, + doc: /* Return the line number at POSITION. +If the buffer is narrowed, the position returned is the position in the +visible part of the buffer. */) + (register Lisp_Object position) +{ + CHECK_FIXNUM (position); + ptrdiff_t pos = XFIXNUM (position); + + /* Check that POSITION is n the visible range of the buffer. */ + if (pos < BEGV || pos > ZV) + args_out_of_range (make_int (BEGV), make_int (ZV)); + + return make_int (count_lines (BEGV_BYTE, CHAR_TO_BYTE (pos)) + 1); +} void @@ -5800,6 +5817,7 @@ syms_of_fns (void) defsubr (&Sdefine_hash_table_test); defsubr (&Sstring_search); defsubr (&Sobject_intervals); + defsubr (&Sline_number_at_position); /* Crypto and hashing stuff. */ DEFSYM (Qiv_auto, "iv-auto"); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index e0aed2a71b6..3a43142106b 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1098,3 +1098,11 @@ (goto-char (point-max)) (insert "fóo") (should (approx-equal (buffer-line-statistics) '(1002 50 49.9))))) + +(ert-deftest test-line-number-at-position () + (with-temp-buffer + (insert (make-string 10 ?\n)) + (should (= (line-number-at-position (point)) 11)) + (should-error (line-number-at-position nil)) + (should-error (line-number-at-position -1)) + (should-error (line-number-at-position 100)))) From e027842f4fb57afbcd117409be12de916b0a1878 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Feb 2021 16:02:30 +0100 Subject: [PATCH 040/297] Fix copyright and license statement in dictionary*.el * lisp/net/dictionary-connection.el: * lisp/net/dictionary.el: Add copyright statement and fix license statement. --- lisp/net/dictionary-connection.el | 18 ++++++++++-------- lisp/net/dictionary.el | 18 ++++++++++-------- 2 files changed, 20 insertions(+), 16 deletions(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index d88c0b48f93..2404a361714 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -1,22 +1,24 @@ ;;; dictionary-connection.el --- TCP-based client connection for dictionary -*- lexical-binding:t -*- +;; Copyright (C) 2021 Free Software Foundation, Inc. + ;; Author: Torsten Hilbrich ;; Keywords: network -;; This file 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, or (at your option) -;; any later version. +;; This file is part of GNU Emacs. -;; This file is distributed in the hope that it will be useful, +;; 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; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 7af8cdc59b2..ccc24cbf303 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1,22 +1,24 @@ ;;; dictionary.el --- Client for rfc2229 dictionary servers -*- lexical-binding:t -*- +;; Copyright (C) 2021 Free Software Foundation, Inc. + ;; Author: Torsten Hilbrich ;; Keywords: interface, dictionary -;; This file 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, or (at your option) -;; any later version. +;; This file is part of GNU Emacs. -;; This file is distributed in the hope that it will be useful, +;; 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; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: From 5a4d50dfb136080fa2353461ee888d552da44a29 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Feb 2021 16:06:06 +0100 Subject: [PATCH 041/297] Minor doc fixes in dictionary-connection.el * lisp/net/dictionary-connection.el: (dictionary-connection-p, dictionary-connection-read-to-point): Minor doc fixes to adhere to our conventions. --- lisp/net/dictionary-connection.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index 2404a361714..8ad4fe4e637 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -23,14 +23,14 @@ ;;; Commentary: ;; dictionary-connection allows to handle TCP-based connections in -;; client mode where text-based information are exchanged. There is +;; client mode where text-based information are exchanged. There is ;; special support for handling CR LF (and the usual CR LF . CR LF ;; terminater). ;;; Code: (defsubst dictionary-connection-p (connection) - "Returns non-nil if CONNECTION is a connection object." + "Return non-nil if CONNECTION is a connection object." (get connection 'connection)) (defsubst dictionary-connection-read-point (connection) @@ -149,8 +149,7 @@ nil: argument is no connection object (defun dictionary-connection-read-to-point (connection) "Read from CONNECTION until an end of entry is encountered. -End of entry is a decimal point found on a line by itself. -" +End of entry is a decimal point found on a line by itself." (dictionary-connection-read connection "\015?\012[.]\015?\012")) (provide 'dictionary-connection) From 56e76f0eb00d92b49ddd5757d0a68d09dc522d39 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 16:28:30 +0100 Subject: [PATCH 042/297] Move line-number-at-pos to C * doc/lispref/positions.texi (Text Lines): Revert previous change. * lisp/simple.el (line-number-at-pos): Remove definition. * lisp/simple.el (count-lines): Revert back to using `forward-line', because there seems to be a disagreement on how lines should be counted in a region... * src/fns.c (Fline_number_at_pos): Rename from Fline_number_at_position and adjust parameter list. --- doc/lispref/positions.texi | 18 ++++++++---------- etc/NEWS | 4 ---- lisp/simple.el | 17 +---------------- src/fns.c | 31 ++++++++++++++++++++++--------- test/src/fns-tests.el | 8 ++++---- 5 files changed, 35 insertions(+), 43 deletions(-) diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 9adce21baec..dc0c7442d8d 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -437,18 +437,16 @@ prints a message reporting the number of lines, words, and characters in the buffer, or in the region if the region is active. @end deffn -@defun line-number-at-position pos -This function returns the line number in the current buffer -corresponding to the buffer position @var{pos}. If narrowing is in -effect, this is the line number in the visible part of the buffer. -@end defun - @defun line-number-at-pos &optional pos absolute @cindex line number -This function is like @code{line-number-at-position}, but if @var{pos} -is @code{nil} or omitted, the current buffer position is used. In -addition, if @var{absolute} is non-@code{nil}, ignore any narrowing -and return the absolute line number. +This function returns the line number in the current buffer +corresponding to the buffer position @var{pos}. If @var{pos} is +@code{nil} or omitted, the current buffer position is used. If +@var{absolute} is @code{nil}, the default, counting starts at +@code{(point-min)}, so the value refers to the contents of the +accessible portion of the (potentially narrowed) buffer. If +@var{absolute} is non-@code{nil}, ignore any narrowing and return +the absolute line number. @end defun @ignore diff --git a/etc/NEWS b/etc/NEWS index 93a60bf14cf..0faed3e5aa2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2192,10 +2192,6 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 -+++ -** New function 'line-number-at-position'. -This returns the line number in the visible portion of the buffer. - --- ** New variable 'indent-line-ignored-functions'. This allows modes to cycle through a set of indentation functions diff --git a/lisp/simple.el b/lisp/simple.el index eab2ac25691..73e3fb9f847 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1472,22 +1472,7 @@ included in the count." (assq prop buffer-invisibility-spec))) (setq invisible-count (1+ invisible-count)))) invisible-count)))) - (t (1- (line-number-at-position (point-max)))))))) - -(defun line-number-at-pos (&optional pos absolute) - "Return buffer line number at position POS. -If POS is nil, use current buffer location. - -If ABSOLUTE is nil, the default, counting starts -at (point-min), so the value refers to the contents of the -accessible portion of the (potentially narrowed) buffer. If -ABSOLUTE is non-nil, ignore any narrowing and return the -absolute line number." - (if absolute - (save-restriction - (widen) - (line-number-at-position (or pos (point)))) - (line-number-at-position (or pos (point))))) + (t (- (buffer-size) (forward-line (buffer-size)))))))) (defcustom what-cursor-show-names nil "Whether to show character names in `what-cursor-position'." diff --git a/src/fns.c b/src/fns.c index 479a5975ce7..d27f63222c4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5759,21 +5759,34 @@ in OBJECT. */) return CDR (collector); } -DEFUN ("line-number-at-position", Fline_number_at_position, - Sline_number_at_position, 1, 1, 0, +DEFUN ("line-number-at-pos", Fline_number_at_pos, + Sline_number_at_pos, 0, 2, 0, doc: /* Return the line number at POSITION. +If POSITION is nil, use the current buffer location. + If the buffer is narrowed, the position returned is the position in the -visible part of the buffer. */) - (register Lisp_Object position) +visible part of the buffer. If ABSOLUTE is non-nil, count the lines +from the absolute start of the buffer. */) + (register Lisp_Object position, Lisp_Object absolute) { - CHECK_FIXNUM (position); - ptrdiff_t pos = XFIXNUM (position); + ptrdiff_t pos, start = BEGV; + + if (NILP (position)) + pos = PT; + else + { + CHECK_FIXNUM (position); + pos = XFIXNUM (position); + } + + if (!NILP (absolute)) + start = BEG_BYTE; /* Check that POSITION is n the visible range of the buffer. */ if (pos < BEGV || pos > ZV) - args_out_of_range (make_int (BEGV), make_int (ZV)); + args_out_of_range (make_int (start), make_int (ZV)); - return make_int (count_lines (BEGV_BYTE, CHAR_TO_BYTE (pos)) + 1); + return make_int (count_lines (start, CHAR_TO_BYTE (pos)) + 1); } @@ -5817,7 +5830,7 @@ syms_of_fns (void) defsubr (&Sdefine_hash_table_test); defsubr (&Sstring_search); defsubr (&Sobject_intervals); - defsubr (&Sline_number_at_position); + defsubr (&Sline_number_at_pos); /* Crypto and hashing stuff. */ DEFSYM (Qiv_auto, "iv-auto"); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3a43142106b..928fb15f109 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1102,7 +1102,7 @@ (ert-deftest test-line-number-at-position () (with-temp-buffer (insert (make-string 10 ?\n)) - (should (= (line-number-at-position (point)) 11)) - (should-error (line-number-at-position nil)) - (should-error (line-number-at-position -1)) - (should-error (line-number-at-position 100)))) + (should (= (line-number-at-pos (point)) 11)) + (should (= (line-number-at-pos nil) 11)) + (should-error (line-number-at-pos -1)) + (should-error (line-number-at-pos 100)))) From 5461808c40ea5baeade203c0a4cc8200855eb00c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 16:42:25 +0100 Subject: [PATCH 043/297] Allow Fline_number_at_pos being called with a marker * src/fns.c (Fline_number_at_pos): Also allow being called with a marker (since the Lisp function allowed that). --- src/fns.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index d27f63222c4..02743c62a57 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5771,7 +5771,9 @@ from the absolute start of the buffer. */) { ptrdiff_t pos, start = BEGV; - if (NILP (position)) + if (MARKERP (position)) + pos = marker_position (position); + else if (NILP (position)) pos = PT; else { From 9380a7ed906e667df4fc5b9d9c8e487fafa7c654 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Sun, 7 Feb 2021 16:51:07 +0100 Subject: [PATCH 044/297] Add command to recenter errors from Occur/Grep buffers To scroll up/down the current displayed occurrence/error without abandon the Occur/Grep buffer. Add also a command 'recenter-other-window' to recenter the other window from any kind of buffer. * lisp/window.el (recenter-other-window): New command. Bind recenter-other-window to S-M-C-l (Bug#46119). * lisp/simple.el (recenter-current-error): New command. * lisp/progmodes/grep.el (grep-mode-map): Delete bidings for n and p. * lisp/progmodes/compile.el (compilation-minor-mode-map): Move here the n and p bindings. Bind `recenter-current-error' to l. * lisp/replace.el (occur-mode-map): Same. * doc/emacs/windows.texi (Other Window): * doc/emacs/display.texi (Recentering): Document recenter-other-window. * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 28.1): Announce the changes. --- doc/emacs/display.texi | 4 ++++ doc/emacs/windows.texi | 8 +++++++- etc/NEWS | 13 +++++++++++-- lisp/progmodes/compile.el | 4 ++++ lisp/progmodes/grep.el | 2 -- lisp/replace.el | 1 + lisp/simple.el | 10 ++++++++++ lisp/window.el | 13 +++++++++++++ 8 files changed, 50 insertions(+), 5 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 2781328cb7d..58d08b43c0e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -173,6 +173,10 @@ line; on subsequent consecutive invocations, make the current line the top line, the bottom line, and so on in cyclic order. Possibly redisplay the screen too (@code{recenter-top-bottom}). +@item C-M-S-l +Scroll the other window; this is equivalent to @kbd{C-l} acting on the +other window. + @item M-x recenter Scroll the selected window so the current line is the center-most text line. Possibly redisplay the screen too. diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index e851f1b1b58..c66deb77487 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -161,6 +161,8 @@ Select another window (@code{other-window}). Scroll the next window upward (@code{scroll-other-window}). @item C-M-S-v Scroll the next window downward (@code{scroll-other-window-down}). +@item C-M-S-l +Recenter the next window (@code{recenter-other-window}). @item mouse-1 @kbd{mouse-1}, in the text area of a window, selects the window and moves point to the position clicked. Clicking in the mode line @@ -194,6 +196,8 @@ rebind a command.) @findex scroll-other-window @kindex C-M-S-v @findex scroll-other-window-down +@kindex C-M-S-l +@findex recenter-other-window The usual scrolling commands (@pxref{Display}) apply to the selected window only, but there are also commands to scroll the next window. @kbd{C-M-v} (@code{scroll-other-window}) scrolls the window that @@ -203,7 +207,9 @@ take positive and negative arguments. (In the minibuffer, @kbd{C-M-v} scrolls the help window associated with the minibuffer, if any, rather than the next window in the standard cyclic order; @pxref{Minibuffer Edit}.) @kbd{C-M-S-v} (@code{scroll-other-window-down}) scrolls the -next window downward in a similar way. +next window downward in a similar way. Likewise, @kbd{C-M-S-l} +(@code{recenter-other-window}) behaves like @kbd{C-l} +(@code{recenter-top-bottom}) in the next window. @vindex mouse-autoselect-window If you set @code{mouse-autoselect-window} to a non-@code{nil} value, diff --git a/etc/NEWS b/etc/NEWS index 0faed3e5aa2..f65e3cf6727 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,7 +85,11 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 -** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA. ++++ +** New command 'recenter-other-window', bound to 'S-M-C-l'. +Like 'recenter-top-bottom' acting in the other window. + +** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA ** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. @@ -469,9 +473,14 @@ applied when the option 'tab-line-tab-face-functions' is so-configured. That option may also be used to customize tab-line faces in other ways. -** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and +** Occur mode + +*** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and 'previous-error-no-select' bound to 'p'. +*** The new command 'recenter-current-error', bound to 'l' in Occur or +compilation buffers, recenters the current displayed occurrence/error. + ** EIEIO +++ diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 614ed7d835d..48b5ee99736 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2069,6 +2069,10 @@ Returns the compilation buffer created." (define-key map "\M-p" 'compilation-previous-error) (define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-}" 'compilation-next-file) + (define-key map "n" 'next-error-no-select) + (define-key map "p" 'previous-error-no-select) + (define-key map "l" 'recenter-current-error) + (define-key map "g" 'recompile) ; revert ;; Set up the menu-bar (define-key map [menu-bar compilation] diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 1a8435fde33..d6ee8bb4236 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -275,8 +275,6 @@ See `compilation-error-screen-columns'." (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) (define-key map "\r" 'compile-goto-error) ;; ? - (define-key map "n" 'next-error-no-select) - (define-key map "p" 'previous-error-no-select) (define-key map "{" 'compilation-previous-file) (define-key map "}" 'compilation-next-file) (define-key map "\t" 'compilation-next-error) diff --git a/lisp/replace.el b/lisp/replace.el index d320542d629..eb7a439b54a 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1161,6 +1161,7 @@ a previously found match." (define-key map "\C-o" 'occur-mode-display-occurrence) (define-key map "n" 'next-error-no-select) (define-key map "p" 'previous-error-no-select) + (define-key map "l" 'recenter-current-error) (define-key map "\M-n" 'occur-next) (define-key map "\M-p" 'occur-prev) (define-key map "r" 'occur-rename-buffer) diff --git a/lisp/simple.el b/lisp/simple.el index 73e3fb9f847..60c13166e70 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -492,6 +492,16 @@ buffer causes automatic display of the corresponding source code location." (overlay-put ol 'window (get-buffer-window)) (setf next-error--message-highlight-overlay ol))))) +(defun recenter-current-error (&optional arg) + "Recenter the current displayed error in the `next-error' buffer." + (interactive "P") + (save-selected-window + (let ((next-error-highlight next-error-highlight-no-select) + (display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (next-error 0) + (set-buffer (window-buffer)) + (recenter-top-bottom arg)))) ;;; diff --git a/lisp/window.el b/lisp/window.el index 92ed6ee0921..2d0a73b426d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9768,6 +9768,19 @@ With plain \\[universal-argument], move current line to window center." (define-key global-map [?\C-l] 'recenter-top-bottom) +(defun recenter-other-window (&optional arg) + "Call `recenter-top-bottom' in the other window. + +A prefix argument is handled like `recenter': + With numeric prefix ARG, move current line to window-line ARG. + With plain `C-u', move current line to window center." + (interactive "P") + (with-selected-window (other-window-for-scrolling) + (recenter-top-bottom arg) + (pulse-momentary-highlight-one-line (point)))) + +(define-key global-map [?\S-\M-\C-l] 'recenter-other-window) + (defun move-to-window-line-top-bottom (&optional arg) "Position point relative to window. From abedf3a8653829f5170ff72b2fc7adad0e6f80d4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Feb 2021 17:52:30 +0200 Subject: [PATCH 045/297] Fix language-environment and font selection on MS-Windows These changes improve setting the language-environment and font selection when MS-Windows returns useless "ZZZ" as the "language name", which then disrupts all the setup of the locale-dependent stuff, and in particular font selection. * lisp/w32-fns.el (w32-charset-info-alist): Add an element for "iso8859-5", in case LANG is set to something unusable, like "ZZZ". This allows fonts capable of displaying Cyrillic characters to be used even when language preferences are screwed. * src/w32.c (init_environment): If GetLocaleInfo returns "ZZZ" as the "language name" for LOCALE_USER_DEFAULT, try again with locale ID based on what GetUserDefaultUILanguage returns. (Bug#39286) --- lisp/w32-fns.el | 1 + src/w32.c | 51 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index eb12dcd8960..687afc828d1 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -252,6 +252,7 @@ bit output with no translation." (w32-add-charset-info "iso8859-2" 'w32-charset-easteurope 28592) (w32-add-charset-info "iso8859-3" 'w32-charset-turkish 28593) (w32-add-charset-info "iso8859-4" 'w32-charset-baltic 28594) + (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) (w32-add-charset-info "iso8859-6" 'w32-charset-arabic 28596) (w32-add-charset-info "iso8859-7" 'w32-charset-greek 28597) (w32-add-charset-info "iso8859-8" 'w32-charset-hebrew 1255) diff --git a/src/w32.c b/src/w32.c index e6dffe2e63f..d4f31924429 100644 --- a/src/w32.c +++ b/src/w32.c @@ -346,6 +346,7 @@ static BOOL g_b_init_get_adapters_addresses; static BOOL g_b_init_reg_open_key_ex_w; static BOOL g_b_init_reg_query_value_ex_w; static BOOL g_b_init_expand_environment_strings_w; +static BOOL g_b_init_get_user_default_ui_language; BOOL g_b_init_compare_string_w; BOOL g_b_init_debug_break_process; @@ -533,6 +534,7 @@ DWORD multiByteToWideCharFlags; typedef LONG (WINAPI *RegOpenKeyExW_Proc) (HKEY,LPCWSTR,DWORD,REGSAM,PHKEY); typedef LONG (WINAPI *RegQueryValueExW_Proc) (HKEY,LPCWSTR,LPDWORD,LPDWORD,LPBYTE,LPDWORD); typedef DWORD (WINAPI *ExpandEnvironmentStringsW_Proc) (LPCWSTR,LPWSTR,DWORD); +typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void); /* ** A utility function ** */ static BOOL @@ -1489,6 +1491,28 @@ expand_environment_strings_w (LPCWSTR lpSrc, LPWSTR lpDst, DWORD nSize) return s_pfn_Expand_Environment_Strings_w (lpSrc, lpDst, nSize); } +static LANGID WINAPI +get_user_default_ui_language (void) +{ + static GetUserDefaultUILanguage_Proc s_pfn_GetUserDefaultUILanguage = NULL; + HMODULE hm_kernel32 = NULL; + + if (is_windows_9x () == TRUE) + return 0; + + if (g_b_init_get_user_default_ui_language == 0) + { + g_b_init_get_user_default_ui_language = 1; + hm_kernel32 = LoadLibrary ("Kernel32.dll"); + if (hm_kernel32) + s_pfn_GetUserDefaultUILanguage = (GetUserDefaultUILanguage_Proc) + get_proc_addr (hm_kernel32, "GetUserDefaultUILanguage"); + } + if (s_pfn_GetUserDefaultUILanguage == NULL) + return 0; + return s_pfn_GetUserDefaultUILanguage (); +} + /* Return 1 if P is a valid pointer to an object of size SIZE. Return @@ -2927,6 +2951,32 @@ init_environment (char ** argv) LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP, locale_name, sizeof (locale_name))) { + /* Microsoft are migrating away of locale IDs, replacing them + with locale names, such as "en-US", and are therefore + deprecating the APIs which use LCID etc. As part of that + deprecation, they don't bother inventing LCID and LANGID + codes for new locales and language/culture combinations; + instead, those get LCID of 0xC000 and LANGID of 0x2000, for + which the LCID/LANGID oriented APIs return "ZZZ" as the + "language name". Such "language name" is useless for our + purposes. So we instead use the default UI language, in the + hope of getting something usable. */ + if (strcmp (locale_name, "ZZZ") == 0) + { + LANGID lang_id = get_user_default_ui_language (); + + if (lang_id != 0) + { + /* Disregard the sorting order differences between cultures. */ + LCID def_lcid = MAKELCID (lang_id, SORT_DEFAULT); + char locale_name_def[32]; + + if (GetLocaleInfo (def_lcid, + LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP, + locale_name_def, sizeof (locale_name_def))) + strcpy (locale_name, locale_name_def); + } + } for (i = 0; i < N_ENV_VARS; i++) { if (strcmp (env_vars[i].name, "LANG") == 0) @@ -10451,6 +10501,7 @@ globals_of_w32 (void) g_b_init_expand_environment_strings_w = 0; g_b_init_compare_string_w = 0; g_b_init_debug_break_process = 0; + g_b_init_get_user_default_ui_language = 0; num_of_processors = 0; /* The following sets a handler for shutdown notifications for console apps. This actually applies to Emacs in both console and From 7c5938ad7d8884d03471e2395937e11611faadb9 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 17:29:57 +0100 Subject: [PATCH 046/297] Use `line-number-at-pos' in `count-lines' * lisp/simple.el (count-lines): Use `line-number-at-pos', which should be faster. --- lisp/simple.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 60c13166e70..568debaa612 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1453,9 +1453,9 @@ included in the count." (save-excursion (save-restriction (narrow-to-region start end) - (goto-char (point-min)) (cond ((and (not ignore-invisible-lines) (eq selective-display t)) + (goto-char (point-min)) (save-match-data (let ((done 0)) (while (re-search-forward "\n\\|\r[^\n]" nil t 40) @@ -1468,6 +1468,7 @@ included in the count." (1+ done) done)))) (ignore-invisible-lines + (goto-char (point-min)) (save-match-data (- (buffer-size) (forward-line (buffer-size)) @@ -1482,7 +1483,11 @@ included in the count." (assq prop buffer-invisibility-spec))) (setq invisible-count (1+ invisible-count)))) invisible-count)))) - (t (- (buffer-size) (forward-line (buffer-size)))))))) + (t + (goto-char (point-max)) + (if (bolp) + (1- (line-number-at-pos)) + (line-number-at-pos))))))) (defcustom what-cursor-show-names nil "Whether to show character names in `what-cursor-position'." From 5a1222196b5a9c3b8afe5c24cd16649a796fa11a Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 7 Feb 2021 19:38:49 +0100 Subject: [PATCH 047/297] ; Rearrange changed entry in etc/NEWS --- etc/NEWS | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index f65e3cf6727..b3d53bf73c9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,12 +85,12 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 +** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA. + +++ ** New command 'recenter-other-window', bound to 'S-M-C-l'. Like 'recenter-top-bottom' acting in the other window. -** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA - ** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. From 4712c75ab853ee77587dbc1910cc7c0401e02aa0 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 22:01:34 +0100 Subject: [PATCH 048/297] Clarify when activate-mark-hook is run * doc/lispref/markers.texi (The Mark): * lisp/simple.el (activate-mark-hook): Clarify when the hook is run (bug#23444). --- doc/lispref/markers.texi | 4 ++-- lisp/simple.el | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi index cdd0938b458..93f98190fa3 100644 --- a/doc/lispref/markers.texi +++ b/doc/lispref/markers.texi @@ -607,8 +607,8 @@ the function @code{use-region-p} for that (@pxref{The Region}). @defvarx deactivate-mark-hook These normal hooks are run, respectively, when the mark becomes active and when it becomes inactive. The hook @code{activate-mark-hook} is -also run at the end of the command loop if the mark is active and it -is possible that the region may have changed. +also run when the region is reactivated, for instance after using a +command that switches back to a buffer that has an active mark. @ignore This piece of command_loop_1, run unless deactivating the mark: if (current_buffer != prev_buffer || MODIFF != prev_modiff) diff --git a/lisp/simple.el b/lisp/simple.el index 10cde4e4b89..28738a262d3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5536,8 +5536,9 @@ START and END specify the portion of the current buffer to be copied." (defvar activate-mark-hook nil "Hook run when the mark becomes active. -It is also run at the end of a command, if the mark is active and -it is possible that the region may have changed.") +It is also run when the region is reactivated, for instance after +using a command that switches back to a buffer that has an active +mark.") (defvar deactivate-mark-hook nil "Hook run when the mark becomes inactive.") From fa735ebc0cd4fbb96ae05b494f7728f5707a8536 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 7 Feb 2021 13:46:50 -0800 Subject: [PATCH 049/297] Fix namazu search result parsing in gnus-search * lisp/gnus/gnus-search.el (gnus-search-indexed-extract): This method is documented to leave point at the end of the extracted search result. The namazu implementation wasn't doing that. --- lisp/gnus/gnus-search.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 0783d34733a..21602f825c1 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1514,6 +1514,7 @@ Namazu provides a little more information, for instance a score." (when (re-search-forward "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)" nil t) + (forward-line 1) (list (match-string 4) (match-string 3)))) From 651aefa31246a786891e2e743800dbf753223928 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Feb 2021 00:24:11 +0100 Subject: [PATCH 050/297] Add tests for count-lines * test/lisp/simple-tests.el (simple-test-count-lines) (simple-test-count-lines/ignore-invisible-lines): Add tests. --- test/lisp/simple-tests.el | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 7b022811a5c..b4007a6c3f3 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -47,6 +47,26 @@ (dotimes (_i 10) (insert (propertize "test " 'field (cons nil nil)))) (should (= (count-words (point-min) (point-max)) 10)))) + +;;; `count-lines' + +(ert-deftest simple-test-count-lines () + (with-temp-buffer + (should (= (count-lines (point-min) (point-max)) 0)) + (insert "foo") + (should (= (count-lines (point-min) (point-max)) 1)) + (insert "\nbar\nbaz\n") + (should (= (count-lines (point-min) (point-max)) 3)) + (insert "r\n") + (should (= (count-lines (point-min) (point-max)) 4)))) + +(ert-deftest simple-test-count-lines/ignore-invisible-lines () + (with-temp-buffer + (insert "foo\nbar") + (should (= (count-lines (point-min) (point-max) t) 2)) + (insert (propertize "\nbar\nbaz\nzut" 'invisible t)) + (should (= (count-lines (point-min) (point-max) t) 2)))) + ;;; `transpose-sexps' (defmacro simple-test--transpositions (&rest body) From 7d4d577ed14fb2519ea2eaecb11c8ecff658f147 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Feb 2021 00:25:16 +0100 Subject: [PATCH 051/297] Prefer setq-local in a few more places * lisp/calc/calc-embed.el (calc-embedded-make-info): * lisp/calc/calcalg2.el (calcFunc-integ): * lisp/comint.el (comint-mode): * lisp/epa.el (epa--list-keys, epa--show-key): * lisp/epg.el (epg--start): * lisp/vc/ediff-util.el (ediff-activate-mark): Prefer setq-local. --- lisp/calc/calc-embed.el | 30 ++++++++++-------------------- lisp/calc/calcalg2.el | 4 +--- lisp/comint.el | 3 +-- lisp/epa.el | 6 ++---- lisp/epg.el | 24 ++++++++---------------- lisp/vc/ediff-util.el | 4 ++-- 6 files changed, 24 insertions(+), 47 deletions(-) diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index cfb3fda106c..74551404776 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -854,31 +854,21 @@ The command \\[yank] can retrieve it from there." (newmode (cl-assoc-if #'derived-mode-p calc-embedded-open-close-mode-alist))) (when newann - (make-local-variable 'calc-embedded-announce-formula) - (setq calc-embedded-announce-formula (cdr newann))) + (setq-local calc-embedded-announce-formula (cdr newann))) (when newform - (make-local-variable 'calc-embedded-open-formula) - (make-local-variable 'calc-embedded-close-formula) - (setq calc-embedded-open-formula (nth 0 (cdr newform))) - (setq calc-embedded-close-formula (nth 1 (cdr newform)))) + (setq-local calc-embedded-open-formula (nth 0 (cdr newform))) + (setq-local calc-embedded-close-formula (nth 1 (cdr newform)))) (when newword - (make-local-variable 'calc-embedded-word-regexp) - (setq calc-embedded-word-regexp (nth 1 newword))) + (setq-local calc-embedded-word-regexp (nth 1 newword))) (when newplain - (make-local-variable 'calc-embedded-open-plain) - (make-local-variable 'calc-embedded-close-plain) - (setq calc-embedded-open-plain (nth 0 (cdr newplain))) - (setq calc-embedded-close-plain (nth 1 (cdr newplain)))) + (setq-local calc-embedded-open-plain (nth 0 (cdr newplain))) + (setq-local calc-embedded-close-plain (nth 1 (cdr newplain)))) (when newnewform - (make-local-variable 'calc-embedded-open-new-formula) - (make-local-variable 'calc-embedded-close-new-formula) - (setq calc-embedded-open-new-formula (nth 0 (cdr newnewform))) - (setq calc-embedded-close-new-formula (nth 1 (cdr newnewform)))) + (setq-local calc-embedded-open-new-formula (nth 0 (cdr newnewform))) + (setq-local calc-embedded-close-new-formula (nth 1 (cdr newnewform)))) (when newmode - (make-local-variable 'calc-embedded-open-mode) - (make-local-variable 'calc-embedded-close-mode) - (setq calc-embedded-open-mode (nth 0 (cdr newmode))) - (setq calc-embedded-close-mode (nth 1 (cdr newmode))))))) + (setq-local calc-embedded-open-mode (nth 0 (cdr newmode))) + (setq-local calc-embedded-close-mode (nth 1 (cdr newmode))))))) (while (and (cdr found) (> point (aref (car (cdr found)) 3))) (setq found (cdr found))) diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index fc6eb74e9f1..94b99aa29d8 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -1545,9 +1545,7 @@ (set-buffer trace-buffer) (goto-char (point-max)) (or (assq 'scroll-stop (buffer-local-variables)) - (progn - (make-local-variable 'scroll-step) - (setq scroll-step 3))) + (setq-local scroll-step 3)) (insert "\n\n\n") (set-buffer calcbuf) (math-try-integral sexpr)) diff --git a/lisp/comint.el b/lisp/comint.el index a9633d08ba1..57df6bfb19f 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -700,8 +700,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'." ;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00827.html ;; ;; This makes it really work to keep point at the bottom. - ;; (make-local-variable 'scroll-conservatively) - ;; (setq scroll-conservatively 10000) + ;; (setq-local scroll-conservatively 10000) (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t) (make-local-variable 'comint-ptyp) (make-local-variable 'comint-process-echoes) diff --git a/lisp/epa.el b/lisp/epa.el index 197cd92f977..572c947e4b2 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -379,8 +379,7 @@ DOC is documentation text to insert at the start." (goto-char point)) (epa--insert-keys (epg-list-keys context name secret))) - (make-local-variable 'epa-list-keys-arguments) - (setq epa-list-keys-arguments (list name secret)) + (setq-local epa-list-keys-arguments (list name secret)) (goto-char (point-min)) (pop-to-buffer (current-buffer))) @@ -500,8 +499,7 @@ If SECRET is non-nil, list secret keys instead of public keys." (format "*Key*%s" (epg-sub-key-id primary-sub-key))))) (set-buffer (cdr entry)) (epa-key-mode) - (make-local-variable 'epa-key) - (setq epa-key key) + (setq-local epa-key key) (erase-buffer) (setq pointer (epg-key-user-id-list key)) (while pointer diff --git a/lisp/epg.el b/lisp/epg.el index 36794d09a75..36515ef4e5f 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -641,22 +641,14 @@ callback data (if any)." (with-current-buffer buffer (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil)) - (make-local-variable 'epg-last-status) - (setq epg-last-status nil) - (make-local-variable 'epg-read-point) - (setq epg-read-point (point-min)) - (make-local-variable 'epg-process-filter-running) - (setq epg-process-filter-running nil) - (make-local-variable 'epg-pending-status-list) - (setq epg-pending-status-list nil) - (make-local-variable 'epg-key-id) - (setq epg-key-id nil) - (make-local-variable 'epg-context) - (setq epg-context context) - (make-local-variable 'epg-agent-file) - (setq epg-agent-file agent-file) - (make-local-variable 'epg-agent-mtime) - (setq epg-agent-mtime agent-mtime)) + (setq-local epg-last-status nil) + (setq-local epg-read-point (point-min)) + (setq-local epg-process-filter-running nil) + (setq-local epg-pending-status-list nil) + (setq-local epg-key-id nil) + (setq-local epg-context context) + (setq-local epg-agent-file agent-file) + (setq-local epg-agent-mtime agent-mtime)) (setq error-process (make-pipe-process :name "epg-error" :buffer (generate-new-buffer " *epg-error*") diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index f955ba8283a..9909dcd5424 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3998,8 +3998,8 @@ Mail anyway? (y or n) ") (define-obsolete-function-alias 'ediff-deactivate-mark #'deactivate-mark "27.1") (defun ediff-activate-mark () - (make-local-variable 'transient-mark-mode) - (setq mark-active 'ediff-util transient-mark-mode t)) + (setq mark-active 'ediff-util) + (setq-local transient-mark-mode t)) (define-obsolete-function-alias 'ediff-nuke-selective-display #'ignore "27.1") From efb10ffdb75ba61353b3451797e0214ac2f03171 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 07:11:52 +0100 Subject: [PATCH 052/297] Fix noninteractive gnus-article-press-button * lisp/gnus/gnus-art.el (gnus-article-press-button): Make the `b' summary mode command work again. --- lisp/gnus/gnus-art.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 70ededf1ba1..7ded9e40e99 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -7894,7 +7894,8 @@ If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property." (interactive (list last-nonmenu-event)) (save-excursion - (mouse-set-point event) + (when event + (mouse-set-point event)) (let ((fun (get-text-property (point) 'gnus-callback))) (when fun (funcall fun (get-text-property (point) 'gnus-data)))))) From f2814b2018f731a9b299422191591e5b1e857827 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 07:22:02 +0100 Subject: [PATCH 053/297] Make `C-a' in enriched-mode behave more line in other modes * lisp/textmodes/enriched.el (enriched-mode-map): Don't rebind beginning-or-line, because it makes `C-S-a' not mark the region, and it doesn't allow actually moving to the beginning of the line if the line starts with characters in `adaptive-fill-regexp' (bug#22554). --- lisp/textmodes/enriched.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index bac209cdef6..fe92d603065 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -186,7 +186,6 @@ The value is a list of \(VAR VALUE VAR VALUE...).") (defvar enriched-mode-map (let ((map (make-sparse-keymap))) - (define-key map [remap move-beginning-of-line] 'beginning-of-line-text) (define-key map "\C-m" 'reindent-then-newline-and-indent) (define-key map [remap newline-and-indent] 'reindent-then-newline-and-indent) From 33c9556c9db9b8c62dcd80dd3cc665e669ea66d4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 07:30:18 +0100 Subject: [PATCH 054/297] Clarify "changes" in CONTRIBUTE * CONTRIBUTE: Clarify that "changes" doesn't include removing code (bug#44834). --- CONTRIBUTE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index cb09391c324..9b2af9ccf13 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -67,7 +67,7 @@ error-prone. It also allows sending patches whose author is someone other than the email sender. Once the cumulative amount of your submissions exceeds about 15 lines -of non-trivial changes, we will need you to assign to the FSF the +of non-trivial code, we will need you to assign to the FSF the copyright for your contributions. Ask on emacs-devel@gnu.org, and we will send you the necessary form together with the instructions to fill and email it, in order to start this legal paperwork. From 798bd1273c5ba85427952e6eee22c8eeda58e85e Mon Sep 17 00:00:00 2001 From: Anticrisis Date: Mon, 8 Feb 2021 07:33:49 +0100 Subject: [PATCH 055/297] Fix tcl-mode indentation of namespaced code * lisp/progmodes/tcl.el (tcl-calculate-indent): Fix indentation when using namespaces (bug#44834). (tcl-beginning-of-defun-function): Remove. This partially reverts cd5bb4bf3dbad8941d25823f398b595b8f0edbb9. Copyright-paperwork-exempt: yes --- lisp/progmodes/tcl.el | 29 +++++------------------------ test/lisp/progmodes/tcl-tests.el | 1 - 2 files changed, 5 insertions(+), 25 deletions(-) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 0a0118a5eba..82e1343e057 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -651,7 +651,6 @@ already exist." (setq-local add-log-current-defun-function #'tcl-add-log-defun) - (setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function) (setq-local end-of-defun-function #'tcl-end-of-defun-function)) @@ -849,14 +848,12 @@ Returns nil if line starts inside a string, t if in a comment." state containing-sexp found-next-line) - (cond - (parse-start + + (if parse-start (goto-char parse-start)) - ((not (beginning-of-defun)) - ;; If we're not in a function, don't use - ;; `tcl-beginning-of-defun-function'. - (let ((beginning-of-defun-function nil)) - (beginning-of-defun)))) + + (beginning-of-defun) + (while (< (point) indent-point) (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) @@ -1035,22 +1032,6 @@ Returns nil if line starts inside a string, t if in a comment." ;; Interfaces to other packages. ;; -(defun tcl-beginning-of-defun-function (&optional arg) - "`beginning-of-defun-function' for Tcl mode." - (when (or (not arg) (= arg 0)) - (setq arg 1)) - (let* ((search-fn (if (> arg 0) - ;; Positive arg means to search backward. - #'re-search-backward - #'re-search-forward)) - (arg (abs arg)) - (result t)) - (while (and (> arg 0) result) - (unless (funcall search-fn tcl-proc-regexp nil t) - (setq result nil)) - (setq arg (1- arg))) - result)) - (defun tcl-end-of-defun-function () "`end-of-defun-function' for Tcl mode." ;; Because we let users redefine tcl-proc-list, we don't really know diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el index cf1ed2896e4..e55eb6d901b 100644 --- a/test/lisp/progmodes/tcl-tests.el +++ b/test/lisp/progmodes/tcl-tests.el @@ -74,7 +74,6 @@ ;; From bug#44834 (ert-deftest tcl-mode-namespace-indent-2 () - :expected-result :failed (with-temp-buffer (tcl-mode) (let ((text "namespace eval Foo {\n proc foo {} {}\n\n proc bar {}{}}\n")) From 657641fb83b927a8da18bccfcf843b0a3b720755 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 8 Feb 2021 07:52:16 +0100 Subject: [PATCH 056/297] Bind clone-buffer to C-x x n * lisp/bindings.el (ctl-x-x-map): Bind clone-buffer. * etc/NEWS: Document the change (bug#46369). --- etc/NEWS | 5 +++-- lisp/bindings.el | 1 + 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b3d53bf73c9..05a8beb7402 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -241,8 +241,9 @@ search buffer due to too many matches being highlighted. ** A new keymap for buffer actions has been added. The 'C-x x' keymap now holds keystrokes for various buffer-oriented commands. The new keystrokes are 'C-x x g' ('revert-buffer'), -'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), -'C-x x i' ('insert-buffer') and 'C-x x t' ('toggle-truncate-lines'). +'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n' +('clone-buffer'), 'C-x x i' ('insert-buffer') and 'C-x x t' +('toggle-truncate-lines'). * Editing Changes in Emacs 28.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index 9462468b1b0..2f4bab11cf5 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1418,6 +1418,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key map "g" #'revert-buffer) (define-key map "r" #'rename-buffer) (define-key map "u" #'rename-uniquely) + (define-key map "n" #'clone-buffer) (define-key map "i" #'insert-buffer) (define-key map "t" #'toggle-truncate-lines) map) From 9fdc753e1450d1b2eb610ef4fc55460d63688799 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Mon, 8 Feb 2021 07:54:54 +0100 Subject: [PATCH 057/297] Add vc-dir faces; also apply them to vc-git * etc/NEWS: Document the new faces. * lisp/vc/vc-dir.el (vc-dir-header, vc-dir-header-value) (vc-dir-directory, vc-dir-file, vc-dir-mark-indicator) (vc-dir-status-warning, vc-dir-status-edited, vc-dir-status-up-to-date) (vc-dir-ignored): Add new faces. * lisp/vc/vc-git.el (vc-git-permissions-as-string, vc-git-dir-printer) (vc-git-dir-extra-headers): Apply new faces (bug#46358). --- etc/NEWS | 6 +++++ lisp/vc/vc-dir.el | 58 ++++++++++++++++++++++++++++++++++++++--------- lisp/vc/vc-git.el | 37 +++++++++++++++--------------- 3 files changed, 71 insertions(+), 30 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 05a8beb7402..40fe2156006 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -601,6 +601,12 @@ their 'default-directory' under VC. This is used when expanding commit messages from 'vc-print-root-log' and similar commands. +--- +*** New faces for 'vc-dir' buffers and their Git VC backend. +Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory', +'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning', +'vc-dir-status-edited', 'vc-dir-status-up-to-date', 'vc-dir-ignored'. + --- *** The responsible VC backend is now the most specific one. 'vc-responsible-backend' loops over the backends in diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9d0808c0435..14c81578b79 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -54,6 +54,42 @@ See `run-hooks'." :type 'hook :group 'vc) +(defface vc-dir-header '((t :inherit font-lock-type-face)) + "Face for headers in VC-dir buffers." + :group 'vc) + +(defface vc-dir-header-value '((t :inherit font-lock-variable-name-face)) + "Face for header values in VC-dir buffers." + :group 'vc) + +(defface vc-dir-directory '((t :inherit font-lock-comment-delimiter-face)) + "Face for directories in VC-dir buffers." + :group 'vc) + +(defface vc-dir-file '((t :inherit font-lock-function-name-face)) + "Face for files in VC-dir buffers." + :group 'vc) + +(defface vc-dir-mark-indicator '((t :inherit font-lock-type-face)) + "Face for mark indicators in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-warning '((t :inherit font-lock-warning-face)) + "Face for warning status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-edited '((t :inherit font-lock-variable-name-face)) + "Face for edited status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-up-to-date '((t :inherit font-lock-builtin-face)) + "Face for up-to-date status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-ignored '((t :inherit shadow)) + "Face for ignored or empty values in VC-dir buffers." + :group 'vc) + ;; Used to store information for the files displayed in the directory buffer. ;; Each item displayed corresponds to one of these defstructs. (cl-defstruct (vc-dir-fileinfo @@ -1126,11 +1162,11 @@ It calls the `dir-extra-headers' backend method to display backend specific headers." (concat ;; First layout the common headers. - (propertize "VC backend : " 'face 'font-lock-type-face) - (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face) - (propertize "Working dir: " 'face 'font-lock-type-face) + (propertize "VC backend : " 'face 'vc-dir-header) + (propertize (format "%s\n" backend) 'face 'vc-dir-header-value) + (propertize "Working dir: " 'face 'vc-dir-header) (propertize (format "%s\n" (abbreviate-file-name dir)) - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) ;; Then the backend specific ones. (vc-call-backend backend 'dir-extra-headers dir) "\n")) @@ -1386,9 +1422,9 @@ These are the commands available for use in the file status buffer: ;; backend specific headers. ;; XXX: change this to return nil before the release. (concat - (propertize "Extra : " 'face 'font-lock-type-face) + (propertize "Extra : " 'face 'vc-dir-header) (propertize "Please add backend specific headers here. It's easy!" - 'face 'font-lock-warning-face))) + 'face 'vc-dir-status-warning))) (defvar vc-dir-status-mouse-map (let ((map (make-sparse-keymap))) @@ -1414,21 +1450,21 @@ These are the commands available for use in the file status buffer: (insert (propertize (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? )) - 'face 'font-lock-type-face) + 'face 'vc-dir-mark-indicator) " " (propertize (format "%-20s" state) - 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) - ((memq state '(missing conflict)) 'font-lock-warning-face) + 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) + ((memq state '(missing conflict)) 'vc-dir-status-warning) ((eq state 'edited) 'font-lock-constant-face) - (t 'font-lock-variable-name-face)) + (t 'vc-dir-header-value)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) " " (propertize (format "%s" filename) 'face - (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face) + (if isdir 'vc-dir-directory 'vc-dir-file) 'help-echo (if isdir "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu" diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index d00c2c2133c..e7306386fea 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -462,7 +462,7 @@ or an empty string if none." (eq 0 (logand ?\111 (logxor old-perm new-perm)))) " " (if (eq 0 (logand ?\111 old-perm)) "+x" "-x")) - 'face 'font-lock-type-face)) + 'face 'vc-dir-header)) (defun vc-git-dir-printer (info) "Pretty-printer for the vc-dir-fileinfo structure." @@ -474,20 +474,20 @@ or an empty string if none." (insert " " (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? )) - 'face 'font-lock-type-face) + 'face 'vc-dir-mark-indicator) " " (propertize (format "%-12s" state) - 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) - ((eq state '(missing conflict)) 'font-lock-warning-face) - (t 'font-lock-variable-name-face)) + 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) + ((eq state '(missing conflict)) 'vc-dir-status-warning) + (t 'vc-dir-status-edited)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) " " (vc-git-permissions-as-string old-perm new-perm) " " (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info)) - 'face (if isdir 'font-lock-comment-delimiter-face - 'font-lock-function-name-face) + 'face (if isdir 'vc-dir-directory + 'vc-dir-file) 'help-echo (if isdir "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu" @@ -784,7 +784,7 @@ or an empty string if none." (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'vc-git-hideable all-hideable 'help-echo vc-git-stash-list-help @@ -800,7 +800,7 @@ or an empty string if none." (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'invisible t 'vc-git-hideable t @@ -810,33 +810,32 @@ or an empty string if none." (propertize "\n" 'invisible t 'vc-git-hideable t)))))))) - ;; FIXME: maybe use a different face when nothing is stashed. (concat - (propertize "Branch : " 'face 'font-lock-type-face) + (propertize "Branch : " 'face 'vc-dir-header) (propertize branch - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) (when remote-url (concat "\n" - (propertize "Remote : " 'face 'font-lock-type-face) + (propertize "Remote : " 'face 'vc-dir-header) (propertize remote-url - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) ;; For now just a heading, key bindings can be added later for various bisect actions (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir))) - (propertize "\nBisect : in progress" 'face 'font-lock-warning-face)) + (propertize "\nBisect : in progress" 'face 'vc-dir-status-warning)) (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir))) - (propertize "\nRebase : in progress" 'face 'font-lock-warning-face)) + (propertize "\nRebase : in progress" 'face 'vc-dir-status-warning)) (if stash-list (concat - (propertize "\nStash : " 'face 'font-lock-type-face) + (propertize "\nStash : " 'face 'vc-dir-header) stash-button stash-string) (concat - (propertize "\nStash : " 'face 'font-lock-type-face) + (propertize "\nStash : " 'face 'vc-dir-header) (propertize "Nothing stashed" 'help-echo vc-git-stash-shared-help 'keymap vc-git-stash-shared-map - 'face 'font-lock-variable-name-face)))))) + 'face 'vc-dir-ignored)))))) (defun vc-git-branches () "Return the existing branches, as a list of strings. From 4428c27c1ae7d5fe5233e8d7b001a8cd2fcdc56f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 08:15:45 +0100 Subject: [PATCH 058/297] Record the value of `C-x C-e' in `values' * lisp/progmodes/elisp-mode.el (eval-last-sexp): Record the value in `values' (bug#22066) since we're messaging it. --- lisp/progmodes/elisp-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 9348a7f0d2f..a0968663163 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1268,7 +1268,9 @@ If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") (if (null eval-expression-debug-on-error) - (elisp--eval-last-sexp eval-last-sexp-arg-internal) + (let ((value (elisp--eval-last-sexp eval-last-sexp-arg-internal))) + (push value values) + value) (let ((value (let ((debug-on-error elisp--eval-last-sexp-fake-value)) (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) From 1a1193c8643d198d5260a4f929cfc1007ed0b39a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Feb 2021 08:23:19 +0100 Subject: [PATCH 059/297] * lisp/avoid.el: Doc fixes. --- lisp/avoid.el | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/lisp/avoid.el b/lisp/avoid.el index b53584ba9c5..3b3848e20d1 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -25,8 +25,10 @@ ;; For those who are annoyed by the mouse pointer obscuring text, ;; this mode moves the mouse pointer - either just a little out of ;; the way, or all the way to the corner of the frame. -;; To use, load or evaluate this file and type M-x mouse-avoidance-mode . -;; To set up permanently, put the following in your .emacs: +;; +;; To use, type `M-x mouse-avoidance-mode'. +;; +;; To set up permanently, put this in your .emacs: ;; ;; (if (display-mouse-p) (mouse-avoidance-mode 'animate)) ;; @@ -47,11 +49,6 @@ ;; ;; For completely random pointer shape, replace the setq above with: ;; (setq x-pointer-shape (mouse-avoidance-random-shape)) -;; -;; Bugs / Warnings / To-Do: -;; -;; - Using this code does slow Emacs down. "banish" mode shouldn't -;; be too bad, and on my workstation even "animate" is reasonable. ;; Credits: ;; This code was helped by all those who contributed suggestions, @@ -76,7 +73,7 @@ "Activate Mouse Avoidance mode. See function `mouse-avoidance-mode' for possible values. Setting this variable directly does not take effect; -use either \\[customize] or the function `mouse-avoidance-mode'." +use either \\[customize] or \\[mouse-avoidance-mode]." :set (lambda (_symbol value) ;; 'none below prevents toggling when value is nil. (mouse-avoidance-mode (or value 'none))) @@ -261,9 +258,9 @@ If you want the mouse banished to a different corner set (t 0)))) (defun mouse-avoidance-nudge-mouse () - ;; Push the mouse a little way away, possibly animating the move. - ;; For these modes, state keeps track of the total offset that we've - ;; accumulated, and tries to keep it close to zero. + "Push the mouse a little way away, possibly animating the move. +For these modes, state keeps track of the total offset that we've +accumulated, and tries to keep it close to zero." (let* ((cur (mouse-position)) (cur-pos (cdr cur)) (pos (window-edges)) @@ -375,7 +372,7 @@ redefine this function to suit your own tastes." (setq mouse-avoidance-state nil)))))) (defun mouse-avoidance-fancy () - ;; Used for the "fancy" modes, ie jump et al. + ;; Used for the "fancy" modes, i.e. jump et al. (if (and (not mouse-avoidance-animating-pointer) (not (mouse-avoidance-ignore-p)) (mouse-avoidance-too-close-p (mouse-position))) From ce35760b19315b634e62e2c64988018189dcdbdc Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Feb 2021 09:03:27 +0100 Subject: [PATCH 060/297] ; Minor license statement fixes --- admin/gitmerge.el | 2 ++ etc/themes/modus-operandi-theme.el | 10 ++++----- etc/themes/modus-vivendi-theme.el | 10 ++++----- lisp/cedet/ede/proj-archive.el | 2 ++ lisp/emacs-lisp/tcover-ses.el | 2 ++ lisp/gnus/gnus-search.el | 8 ++++--- lisp/jsonrpc.el | 8 ++++--- lisp/org/ol-w3m.el | 6 ++--- lisp/org/org-refile.el | 6 ++--- test/lisp/dom-tests.el | 2 ++ test/lisp/emacs-lisp/cl-extra-tests.el | 22 +++++++++---------- test/lisp/emacs-lisp/cl-lib-tests.el | 22 +++++++++---------- test/lisp/emacs-lisp/cl-macs-tests.el | 22 +++++++++---------- .../edebug-resources/edebug-test-code.el | 22 +++++++++---------- test/lisp/emacs-lisp/edebug-tests.el | 22 +++++++++---------- test/lisp/emacs-lisp/ert-tests.el | 22 +++++++++---------- test/lisp/emacs-lisp/ert-x-tests.el | 22 +++++++++---------- test/lisp/emacs-lisp/lisp-mode-tests.el | 2 ++ test/lisp/emacs-lisp/lisp-tests.el | 2 ++ .../testcover-resources/testcases.el | 22 +++++++++---------- test/lisp/emacs-lisp/testcover-tests.el | 22 +++++++++---------- test/lisp/gnus/gnus-search-tests.el | 8 ++++--- test/lisp/gnus/gnus-util-tests.el | 8 +++---- test/lisp/gnus/mm-decode-tests.el | 6 ++--- test/lisp/gnus/mml-sec-tests.el | 9 ++++---- test/lisp/net/sasl-scram-rfc-tests.el | 2 ++ test/lisp/nxml/nxml-mode-tests.el | 2 ++ test/lisp/nxml/xsd-regexp-tests.el | 2 ++ test/lisp/obsolete/cl-tests.el | 22 +++++++++---------- test/src/fns-tests.el | 22 +++++++++---------- test/src/indent-tests.el | 22 +++++++++---------- 31 files changed, 193 insertions(+), 168 deletions(-) diff --git a/admin/gitmerge.el b/admin/gitmerge.el index b92ecc7c78f..851212c7bb1 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -7,6 +7,8 @@ ;; Keywords: maint +;; 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 diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index c7a0f72c103..346000a0935 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -10,18 +10,18 @@ ;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or +;; 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. -;; -;; This program is distributed in the hope that it will be useful, + +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 6e71e8d8e3a..73f07d644b7 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -10,18 +10,18 @@ ;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or +;; 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. -;; -;; This program is distributed in the hope that it will be useful, + +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el index 2b1e50dcea3..038f994e4f9 100644 --- a/lisp/cedet/ede/proj-archive.el +++ b/lisp/cedet/ede/proj-archive.el @@ -5,6 +5,8 @@ ;; Author: Eric M. Ludlam ;; Keywords: project, make +;; 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 diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el index fb9cd8f47df..12b0dcfff95 100644 --- a/lisp/emacs-lisp/tcover-ses.el +++ b/lisp/emacs-lisp/tcover-ses.el @@ -6,6 +6,8 @@ ;; Keywords: spreadsheet lisp utility ;; Package: testcover +;; 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 diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 21602f825c1..4538370584b 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -4,18 +4,20 @@ ;; Author: Eric Abrahamsen -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 7f5aa8295fe..f1fb6c1ddaf 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -10,18 +10,20 @@ ;; This is a GNU ELPA :core package. Avoid functionality that is not ;; compatible with the version of Emacs recorded above. -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ol-w3m.el b/lisp/org/ol-w3m.el index f1f3afd764d..ebb11ce3d54 100644 --- a/lisp/org/ol-w3m.el +++ b/lisp/org/ol-w3m.el @@ -7,13 +7,13 @@ ;; Homepage: https://orgmode.org ;; ;; This file is part of GNU Emacs. -;; -;; This program is free software: you can redistribute it and/or modify + +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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. diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 1e0c339f7b2..8b42f817c1a 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -7,18 +7,18 @@ ;; ;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index dbe3a15dac1..0a0d783b824 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -5,6 +5,8 @@ ;; Author: Simen Heggestøyl ;; Keywords: +;; 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 diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el index f3c308725ac..91f0a1e2014 100644 --- a/test/lisp/emacs-lisp/cl-extra-tests.el +++ b/test/lisp/emacs-lisp/cl-extra-tests.el @@ -4,18 +4,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 065ca4fa651..a5ec62b9c42 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -4,18 +4,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index bcd63f73a3c..2e5f3020b41 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -4,18 +4,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index a3010f9e354..f8ca39c8c6e 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -6,18 +6,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index d60a6cb3d50..6a6080df3c8 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -6,18 +6,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 40cb432708e..bdacb0832b3 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -6,18 +6,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index f46fa63e4ce..9f40a18d343 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -7,18 +7,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 85db3a00c8e..e2cecdf6b01 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -2,6 +2,8 @@ ;; Copyright (C) 2017-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 diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index fd07011137a..78ecf3ff03d 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -8,6 +8,8 @@ ;; Author: Marcin Borkowski ;; Keywords: internal +;; 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 diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el index 5dbf2272b1a..7ced257c6f9 100644 --- a/test/lisp/emacs-lisp/testcover-resources/testcases.el +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el @@ -6,18 +6,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el index 9f0312d85ff..7854e33e77d 100644 --- a/test/lisp/emacs-lisp/testcover-tests.el +++ b/test/lisp/emacs-lisp/testcover-tests.el @@ -6,18 +6,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/gnus/gnus-search-tests.el b/test/lisp/gnus/gnus-search-tests.el index 63469f8d518..e30ed9a80a7 100644 --- a/test/lisp/gnus/gnus-search-tests.el +++ b/test/lisp/gnus/gnus-search-tests.el @@ -5,18 +5,20 @@ ;; Author: Eric Abrahamsen ;; Keywords: -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el index 7f64b96303f..959be7987d3 100644 --- a/test/lisp/gnus/gnus-util-tests.el +++ b/test/lisp/gnus/gnus-util-tests.el @@ -3,12 +3,12 @@ ;; Author: Jens Lechtenbörger -;; This file is not part of GNU Emacs. +;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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, or (at your option) -;; any later version. +;; 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 diff --git a/test/lisp/gnus/mm-decode-tests.el b/test/lisp/gnus/mm-decode-tests.el index 7d059cb3f87..586097aaf31 100644 --- a/test/lisp/gnus/mm-decode-tests.el +++ b/test/lisp/gnus/mm-decode-tests.el @@ -4,10 +4,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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, or (at your option) -;; any later version. +;; 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 diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index b743187030f..a7ed7d3975b 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -1,14 +1,15 @@ ;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*- lexical-binding:t -*- + ;; Copyright (C) 2015, 2020-2021 Free Software Foundation, Inc. ;; Author: Jens Lechtenbörger -;; This file is not part of GNU Emacs. +;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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, or (at your option) -;; any later version. +;; 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 diff --git a/test/lisp/net/sasl-scram-rfc-tests.el b/test/lisp/net/sasl-scram-rfc-tests.el index 3e9879a49d4..dfd4cf0e7ac 100644 --- a/test/lisp/net/sasl-scram-rfc-tests.el +++ b/test/lisp/net/sasl-scram-rfc-tests.el @@ -4,6 +4,8 @@ ;; Author: Magnus Henoch +;; 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 diff --git a/test/lisp/nxml/nxml-mode-tests.el b/test/lisp/nxml/nxml-mode-tests.el index 4baab1f7600..7824691333e 100644 --- a/test/lisp/nxml/nxml-mode-tests.el +++ b/test/lisp/nxml/nxml-mode-tests.el @@ -2,6 +2,8 @@ ;; Copyright (C) 2019-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 diff --git a/test/lisp/nxml/xsd-regexp-tests.el b/test/lisp/nxml/xsd-regexp-tests.el index 4dbc8999247..2194602dbec 100644 --- a/test/lisp/nxml/xsd-regexp-tests.el +++ b/test/lisp/nxml/xsd-regexp-tests.el @@ -2,6 +2,8 @@ ;; Copyright (C) 2019-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 diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el index 4a5f4f872b6..0e02e1ca1bc 100644 --- a/test/lisp/obsolete/cl-tests.el +++ b/test/lisp/obsolete/cl-tests.el @@ -4,18 +4,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 928fb15f109..9f6593a177c 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -4,18 +4,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el index 10f1202949b..6a3f1a5c95f 100644 --- a/test/src/indent-tests.el +++ b/test/src/indent-tests.el @@ -4,18 +4,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Commentary: From cfb91b5bca51dadce661d51cd6bd3df94a2d5761 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Feb 2021 09:18:41 -0500 Subject: [PATCH 061/297] * lisp/indent.el (beginning-of-line-text): Mark it as a movement command So that combining it with `shift` selects the text, as usual, in case you have it bound for example to `C-a` in a mode like `enriched-mode`. --- lisp/indent.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/indent.el b/lisp/indent.el index 5cbf0acaa25..285b8e2038f 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -525,7 +525,7 @@ From the beginning of the line, moves past the left-margin indentation, the fill-prefix, and any indentation used for centering or right-justifying the line, but does not move past any whitespace that was explicitly inserted \(such as a tab used to indent the first line of a paragraph)." - (interactive "p") + (interactive "^p") (beginning-of-line n) (skip-chars-forward " \t") ;; Skip over fill-prefix. From 6b351b2d7608def23cc4bbd76ba8dc300708e953 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 8 Feb 2021 18:04:00 +0200 Subject: [PATCH 062/297] Fix scrolling past tall images * src/xdisp.c (try_window): Don't try checking the margins if the window is vscrolled, as that could cause unnecessary recentering when tall images are displayed. (Bug#46320) --- src/xdisp.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 1815f986781..fb8eaf4b967 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19452,8 +19452,11 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) 'start_display' again. */ ptrdiff_t it_charpos = IT_CHARPOS (it); - /* Don't let the cursor end in the scroll margins. */ + /* Don't let the cursor end in the scroll margins. However, when + the window is vscrolled, we leave it to vscroll to handle the + margins, see window_scroll_pixel_based. */ if ((flags & TRY_WINDOW_CHECK_MARGINS) + && w->vscroll == 0 && !MINI_WINDOW_P (w)) { int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); @@ -19462,7 +19465,7 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); start_display (&it, w, pos); - if ((w->cursor.y >= 0 /* not vscrolled */ + if ((w->cursor.y >= 0 && w->cursor.y < top_scroll_margin && CHARPOS (pos) > BEGV) /* rms: considering make_cursor_line_fully_visible_p here From 120149cf6a82dd20dfade3b2c09996f7be562441 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 07:30:18 +0100 Subject: [PATCH 063/297] Clarify "changes" in CONTRIBUTE * CONTRIBUTE: Clarify that "changes" doesn't include removing code (bug#44834). (cherry picked from commit 33c9556c9db9b8c62dcd80dd3cc665e669ea66d4) --- CONTRIBUTE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 4e42c7aafcc..125c183229f 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -67,7 +67,7 @@ error-prone. It also allows sending patches whose author is someone other than the email sender. Once the cumulative amount of your submissions exceeds about 15 lines -of non-trivial changes, we will need you to assign to the FSF the +of non-trivial code, we will need you to assign to the FSF the copyright for your contributions. Ask on emacs-devel@gnu.org, and we will send you the necessary form together with the instructions to fill and email it, in order to start this legal paperwork. From dcc00bbb1989b27c49442422e7fbaf8c3f6415cb Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 8 Feb 2021 18:09:21 +0200 Subject: [PATCH 064/297] ; * CONTRIBUTE: Clarify the "15-lines" rule a bit more. --- CONTRIBUTE | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 125c183229f..9f0d9e7e164 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -67,10 +67,11 @@ error-prone. It also allows sending patches whose author is someone other than the email sender. Once the cumulative amount of your submissions exceeds about 15 lines -of non-trivial code, we will need you to assign to the FSF the -copyright for your contributions. Ask on emacs-devel@gnu.org, and we -will send you the necessary form together with the instructions to -fill and email it, in order to start this legal paperwork. +of non-trivial code you added or changed (not counting deleted lines), +we will need you to assign to the FSF the copyright for your +contributions. Ask on emacs-devel@gnu.org, and we will send you the +necessary form together with the instructions to fill and email it, in +order to start this legal paperwork. ** Issue tracker (a.k.a. "bug tracker") From 9a698da7dea51a59aa9ddfb71887ac6b865883dc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 8 Feb 2021 18:19:31 +0200 Subject: [PATCH 065/297] ; * etc/NEWS: Call out a recent change in Enriched mode. --- etc/NEWS | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 40fe2156006..513004885cb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1620,6 +1620,13 @@ that makes it a valid button. *** New variable 'thing-at-point-provider-alist'. This allows mode-specific alterations to how 'thing-at-point' works. +** Enriched mode + +--- +*** 'C-a' is by default no longer bound to 'beginning-of-line-text'. +This is so 'C-a' works as in other modes, and in particular holding +Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text. + ** Miscellaneous +++ From 1b0e6a16d3ae32576a642898c39695a3affd2fd7 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Mon, 8 Feb 2021 12:27:04 -0800 Subject: [PATCH 066/297] Run Gnus group names through regexp-quote when matching results * lisp/gnus/gnus-search.el (gnus-search-indexed-parse-output): Be more careful about making sure group names will match search results correctly. --- lisp/gnus/gnus-search.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 4538370584b..d7b1c06114b 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1348,12 +1348,14 @@ Returns a list of [group article score] vectors." (let ((prefix (slot-value engine 'remove-prefix)) (group-regexp (when groups (mapconcat - (lambda (x) - (replace-regexp-in-string - ;; Accept any of [.\/] as path separators. - "[.\\/]" "[.\\\\/]" - (gnus-group-real-name x))) - groups "\\|"))) + (lambda (group-name) + (mapconcat #'regexp-quote + (split-string + (gnus-group-real-name group-name) + "[.\\/]") + "[.\\\\/]")) + groups + "\\|"))) artlist vectors article group) (goto-char (point-min)) (while (not (eobp)) From 69943ae70ce0aec075bd26ad0100c174b34bad7f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Feb 2021 19:08:14 -0500 Subject: [PATCH 067/297] * lisp/gnus/gnus-topic.el: Fix a backward incompatibility (gnus-topic-insert-topic-line): Make the vars used in `gnus-topic-line-format-spec` dynamically scoped since it seems that they're sometimes accessed from functions called by `gnus-topic-line-format-spec` :-( * lisp/gnus/gnus-util.el (gnus--\,@): Move macro to here... * lisp/gnus/gnus-art.el (gnus--\,@): .. from here. * lisp/gnus/gnus.el (gnus-method-to-server): Apply DeMorgan. --- lisp/gnus/gnus-art.el | 4 ---- lisp/gnus/gnus-topic.el | 16 ++++++++-------- lisp/gnus/gnus-util.el | 5 +++++ lisp/gnus/gnus.el | 6 +++--- 4 files changed, 16 insertions(+), 15 deletions(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7ded9e40e99..c9afa3ac948 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4325,10 +4325,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is (if (gnus-buffer-live-p gnus-original-article-buffer) (canlock-verify gnus-original-article-buffer))) -(defmacro gnus--\,@ (exp) - (declare (debug t)) - `(progn ,@(eval exp t))) - (gnus--\,@ (mapcar (lambda (func) `(defun ,(intern (format "gnus-%s" func)) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index e7d1cf86161..3253b7853dc 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -627,7 +627,14 @@ articles in the topic and its subtopics." (defun gnus-topic-insert-topic-line (name visiblep shownp level entries &optional unread) + (gnus--\,@ + (let ((vars '(indentation visible name level number-of-groups + total-number-of-articles entries))) + `((with-suppressed-warnings ((lexical ,@vars)) + ,@(mapcar (lambda (s) `(defvar ,s)) vars))))) (let* ((visible (if visiblep "" "...")) + (level level) + (name name) (indentation (make-string (* gnus-topic-indent-level level) ? )) (total-number-of-articles unread) (number-of-groups (length entries)) @@ -640,14 +647,7 @@ articles in the topic and its subtopics." (add-text-properties (point) (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec - `((indentation . ,indentation) - (visible . ,visible) - (name . ,name) - (level . ,level) - (number-of-groups . ,number-of-groups) - (total-number-of-articles . ,total-number-of-articles) - (entries . ,entries)))) + (eval gnus-topic-line-format-spec t)) (list 'gnus-topic name 'gnus-topic-level level 'gnus-topic-unread unread diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 3c7c948c2b5..f80243cfedb 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1068,6 +1068,11 @@ ARG is passed to the first function." ;;; Various +(defmacro gnus--\,@ (exp) + "Splice EXP's value (a list of Lisp forms) into the code." + (declare (debug t)) + `(progn ,@(eval exp t))) + (defvar gnus-group-buffer) ; Compiler directive (defun gnus-alive-p () "Say whether Gnus is running or not." diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 98664ac2b44..7b94c64ae7b 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3212,9 +3212,9 @@ that that variable is buffer-local to the summary buffers." (format "%s" (car method)) (format "%s:%s" (car method) (cadr method)))) (name-method (cons name method))) - (when (and (not no-enter-cache) - (not (member name-method gnus-server-method-cache)) - (not (assoc (car name-method) gnus-server-method-cache))) + (unless (or no-enter-cache + (member name-method gnus-server-method-cache) + (assoc (car name-method) gnus-server-method-cache)) (push name-method gnus-server-method-cache)) name))) From f3fd9591cfca5450b4bc74274340f24068f96fc7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Feb 2021 08:12:10 +0100 Subject: [PATCH 068/297] Fix count-lines problem in non-ASCII buffers * src/fns.c (Fline_number_at_pos): Get the correct start position in non-ASCII buffers (bug#22763). --- src/fns.c | 2 +- test/lisp/simple-tests.el | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index 02743c62a57..c16f9c63998 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5769,7 +5769,7 @@ visible part of the buffer. If ABSOLUTE is non-nil, count the lines from the absolute start of the buffer. */) (register Lisp_Object position, Lisp_Object absolute) { - ptrdiff_t pos, start = BEGV; + ptrdiff_t pos, start = BEGV_BYTE; if (MARKERP (position)) pos = marker_position (position); diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index b4007a6c3f3..f2ddc2e3fb3 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -67,6 +67,11 @@ (insert (propertize "\nbar\nbaz\nzut" 'invisible t)) (should (= (count-lines (point-min) (point-max) t) 2)))) +(ert-deftest simple-text-count-lines-non-ascii () + (with-temp-buffer + (insert "あ\nい\nう\nえ\nお\n") + (should (= (count-lines (point) (point)) 0)))) + ;;; `transpose-sexps' (defmacro simple-test--transpositions (&rest body) From fe449d8e081be9f09f29e5009bca0e152be85192 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Feb 2021 08:20:08 +0100 Subject: [PATCH 069/297] Finish customize-changed-options/customize-changed fix up * doc/emacs/custom.texi (Specific Customization): Fix customize-changed/customize-changed-options documentation. * lisp/cus-dep.el (custom-make-dependencies): Adjust doc string (bug#23085). * lisp/menu-bar.el (menu-bar-custom-menu): Adjust menu options. --- doc/emacs/custom.texi | 9 +++------ lisp/cus-dep.el | 4 ++-- lisp/cus-edit.el | 2 +- lisp/menu-bar.el | 6 +++--- 4 files changed, 9 insertions(+), 12 deletions(-) diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index ccf5f1932f9..22900c57392 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -519,12 +519,9 @@ Set up a customization buffer for all the settings and groups that match @var{regexp}. @item M-x customize-changed @key{RET} @var{version} @key{RET} -Set up a customization buffer with all the settings and groups -whose meaning has changed since Emacs version @var{version}. - -@item M-x customize-changed-options @key{RET} @var{version} @key{RET} -Set up a customization buffer with all the options whose meaning or -default values have changed since Emacs version @var{version}. +Set up a customization buffer with all the user options, faces and +groups whose meaning has changed since (or been added after) Emacs +version @var{version}. @item M-x customize-saved Set up a customization buffer containing all settings that you diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index a52d08266c1..f0b108b77d6 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -178,7 +178,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (insert "\ ;; The remainder of this file is for handling :version. -;; We provide a minimum of information so that `customize-changed-options' +;; We provide a minimum of information so that `customize-changed' ;; can do its job. ;; For groups we set `custom-version', `group-documentation' and @@ -239,7 +239,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" This is an alist whose members have as car a version string, and as elements the files that have variables or faces that contain that version. These files should be loaded before showing the customization -buffer that `customize-changed-options' generates.\")\n\n")) +buffer that `customize-changed' generates.\")\n\n")) (save-buffer) (byte-compile-info (format "Generating %s...done" generated-custom-dependencies-file) t)) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index cd1ae964eb9..dde6e8997bf 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1206,7 +1206,7 @@ Show the buffer in another window, but don't select it." (message "`%s' is an alias for `%s'" symbol basevar)))) (defvar customize-changed-options-previous-release "26.3" - "Version for `customize-changed-options' to refer back to by default.") + "Version for `customize-changed' to refer back to by default.") ;; Packages will update this variable, so make it available. ;;;###autoload diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 2fdfcc8b582..133df65cbcb 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -636,9 +636,9 @@ Do the same for the keys of the same name." :help "Customize value of specific option")) (bindings--define-key menu [separator-2] menu-bar-separator) - (bindings--define-key menu [customize-changed-options] - '(menu-item "New Options..." customize-changed-options - :help "Options added or changed in recent Emacs versions")) + (bindings--define-key menu [customize-changed] + '(menu-item "New Options..." customize-changed + :help "Options and faces added or changed in recent Emacs versions")) (bindings--define-key menu [customize-saved] '(menu-item "Saved Options" customize-saved :help "Customize previously saved options")) From 900ed3ad84c2144ca6bd86f3f7bd20f1c9347eb1 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Feb 2021 08:32:40 +0100 Subject: [PATCH 070/297] Don't use `values' in elisp--eval-defun * lisp/progmodes/elisp-mode.el (elisp--eval-defun): Don't use `values', since it's being deprecated (bug#22066). --- lisp/progmodes/elisp-mode.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index a0968663163..9a36206bfda 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1339,7 +1339,8 @@ Return the result of evaluation." ;; printing, not while evaluating. (let ((debug-on-error eval-expression-debug-on-error) (print-length eval-expression-print-length) - (print-level eval-expression-print-level)) + (print-level eval-expression-print-level) + elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. ;; eval-region handles recording which file defines a function or @@ -1355,17 +1356,18 @@ Return the result of evaluation." (setq end (point))) ;; Alter the form if necessary. (let ((form (eval-sexp-add-defvars - (elisp--eval-defun-1 (macroexpand form))))) + (elisp--eval-defun-1 + (macroexpand + `(setq elisp--eval-defun-result ,form)))))) (eval-region beg end standard-output (lambda (_ignore) ;; Skipping to the end of the specified region ;; will make eval-region return. (goto-char end) - form)))))) - (let ((str (eval-expression-print-format (car values)))) - (if str (princ str))) - ;; The result of evaluation has been put onto VALUES. So return it. - (car values)) + form))))) + (let ((str (eval-expression-print-format elisp--eval-defun-result))) + (if str (princ str))) + elisp--eval-defun-result)) (defun eval-defun (edebug-it) "Evaluate the top-level form containing point, or after point. From 0cc35e14319d6b113049f5389629dc693541a14c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Feb 2021 09:04:47 +0100 Subject: [PATCH 071/297] Move all usages of `values' to `values--store-value' * lisp/simple.el (eval-expression): * lisp/progmodes/elisp-mode.el (eval-last-sexp): * lisp/emacs-lisp/pp.el (pp-eval-expression): * lisp/emacs-lisp/edebug.el (edebug-eval-expression): * lisp/emacs-lisp/pp.el (pp-eval-expression): * lisp/emacs-lisp/edebug.el (edebug-eval-expression): * lisp/cedet/data-debug.el (data-debug-eval-expression): Use it instead of pushing to `values' directly (bug#22066). * lisp/subr.el (values--store-value): New function. --- lisp/cedet/data-debug.el | 44 +++++++++++++++---------------- lisp/emacs-lisp/edebug.el | 7 ++--- lisp/emacs-lisp/pp.el | 5 ++-- lisp/progmodes/elisp-mode.el | 5 ++-- lisp/simple.el | 51 +++++++++++++++++++----------------- lisp/subr.el | 10 +++++++ 6 files changed, 68 insertions(+), 54 deletions(-) diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index a062a5a5853..f0fa91b3b17 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -1045,30 +1045,30 @@ If the result is a list or vector, then use the data debugger to display it." (list (let ((minibuffer-completing-symbol t)) (read-from-minibuffer "Eval: " nil read-expression-map t - 'read-expression-history)) - )) + 'read-expression-history)))) - (if (null eval-expression-debug-on-error) - (setq values (cons (eval expr) values)) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (setq values (cons (eval expr) values)) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) + (let (result) + (if (null eval-expression-debug-on-error) + (setq result (values--store-value (eval expr))) + (let ((old-value (make-symbol "t")) new-value) + ;; Bind debug-on-error to something unique so that we can + ;; detect when evalled code changes it. + (let ((debug-on-error old-value)) + (setq result (values--store-value (eval expr))) + (setq new-value debug-on-error)) + ;; If evalled code has changed the value of debug-on-error, + ;; propagate that change to the global binding. + (unless (eq old-value new-value) + (setq debug-on-error new-value)))) - (if (or (consp (car values)) (vectorp (car values))) - (let ((v (car values))) - (data-debug-show-stuff v "Expression")) - ;; Old style - (prog1 - (prin1 (car values) t) - (let ((str (eval-expression-print-format (car values)))) - (if str (princ str t)))))) + (if (or (consp result) (vectorp result)) + (let ((v result)) + (data-debug-show-stuff v "Expression")) + ;; Old style + (prog1 + (prin1 result t) + (let ((str (eval-expression-print-format result))) + (if str (princ str t))))))) (provide 'data-debug) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 5d595851b9f..41768f26708 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3801,9 +3801,10 @@ Print result in minibuffer." (interactive (list (read--expression "Eval: "))) (princ (edebug-outside-excursion - (setq values (cons (edebug-eval expr) values)) - (concat (edebug-safe-prin1-to-string (car values)) - (eval-expression-print-format (car values)))))) + (let ((result (edebug-eval expr))) + (values--store-value result) + (concat (edebug-safe-prin1-to-string result) + (eval-expression-print-format result)))))) (defun edebug-eval-last-sexp (&optional no-truncate) "Evaluate sexp before point in the outside environment. diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index ef4c9603284..2fd4724aef1 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -127,8 +127,9 @@ Also add the value to the front of the list in the variable `values'." (interactive (list (read--expression "Eval: "))) (message "Evaluating...") - (push (eval expression lexical-binding) values) - (pp-display-expression (car values) "*Pp Eval Output*")) + (let ((result (eval expression lexical-binding))) + (values--store-value result) + (pp-display-expression result "*Pp Eval Output*"))) ;;;###autoload (defun pp-macroexpand-expression (expression) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 9a36206bfda..0325d4ea756 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1268,9 +1268,8 @@ If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") (if (null eval-expression-debug-on-error) - (let ((value (elisp--eval-last-sexp eval-last-sexp-arg-internal))) - (push value values) - value) + (values--store-values + (elisp--eval-last-sexp eval-last-sexp-arg-internal)) (let ((value (let ((debug-on-error elisp--eval-last-sexp-fake-value)) (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) diff --git a/lisp/simple.el b/lisp/simple.el index 568debaa612..0c5bcb66724 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1809,31 +1809,34 @@ this command arranges for all errors to enter the debugger." (cons (read--expression "Eval: ") (eval-expression-get-print-arguments current-prefix-arg))) - (if (null eval-expression-debug-on-error) - (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t) - values) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t) - values) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) + (let (result) + (if (null eval-expression-debug-on-error) + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) + (let ((old-value (make-symbol "t")) new-value) + ;; Bind debug-on-error to something unique so that we can + ;; detect when evalled code changes it. + (let ((debug-on-error old-value)) + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) + (setq new-value debug-on-error)) + ;; If evalled code has changed the value of debug-on-error, + ;; propagate that change to the global binding. + (unless (eq old-value new-value) + (setq debug-on-error new-value)))) - (let ((print-length (unless no-truncate eval-expression-print-length)) - (print-level (unless no-truncate eval-expression-print-level)) - (eval-expression-print-maximum-character char-print-limit) - (deactivate-mark)) - (let ((out (if insert-value (current-buffer) t))) - (prog1 - (prin1 (car values) out) - (let ((str (and char-print-limit - (eval-expression-print-format (car values))))) - (when str (princ str out))))))) + (let ((print-length (unless no-truncate eval-expression-print-length)) + (print-level (unless no-truncate eval-expression-print-level)) + (eval-expression-print-maximum-character char-print-limit) + (deactivate-mark)) + (let ((out (if insert-value (current-buffer) t))) + (prog1 + (prin1 result out) + (let ((str (and char-print-limit + (eval-expression-print-format result)))) + (when str (princ str out)))))))) (defun edit-and-eval-command (prompt command) "Prompting with PROMPT, let user edit COMMAND and eval result. diff --git a/lisp/subr.el b/lisp/subr.el index f0de6d5ac92..6573090ebe3 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1655,6 +1655,12 @@ The return value has the form (WIDTH . HEIGHT). POSITION should be a list of the form returned by `event-start' and `event-end'." (nth 9 position)) +(defun values--store-value (value) + "Store VALUE in the obsolete `values' variable." + (with-suppressed-warnings ((obsolete values)) + (push value values)) + value) + ;;;; Obsolescent names for functions. @@ -1721,6 +1727,10 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete-variable 'load-dangerous-libraries "no longer used." "27.1") +;; We can't actually make `values' obsolete, because that will result +;; in warnings when using `values' in let-bindings. +;;(make-obsolete-variable 'values "no longer used" "28.1") + ;;;; Alternate names for functions - these are not being phased out. From 9c1e89a32c65244a992a8a1ff73fd606f94a8a15 Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Tue, 9 Feb 2021 09:10:45 +0100 Subject: [PATCH 072/297] Preserve leading whitespace in `lm-commentary'. * lisp/emacs-lisp/lisp-mnt.el (lm-commentary): Preserve leading whitespace (bug#46364). --- lisp/emacs-lisp/lisp-mnt.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index adb9cb2372c..6d9c8c32794 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -495,7 +495,7 @@ absent, return nil." (concat "^;;;[[:blank:]]*\\(" lm-commentary-header "\\):[[:blank:]\n]*") - "^;;[[:blank:]]*" ; double semicolon prefix + "^;;[[:blank:]]?" ; double semicolon prefix "[[:blank:]\n]*\\'") ; trailing new-lines "" (buffer-substring-no-properties start (lm-commentary-end)))))))) From 5131e3accccc7bb3d59ab03cbb990eb3261ee9da Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Feb 2021 09:20:11 +0100 Subject: [PATCH 073/297] Make pcomplete-ignore-case obsolete * lisp/pcomplete.el (pcomplete-completions-at-point) (pcomplete-stub, pcomplete--entries, pcomplete-insert-entry): * lisp/eshell/em-cmpl.el (eshell-cmpl-initialize): * lisp/eshell/em-cmpl.el (eshell-cmpl-ignore-case): * lisp/erc/erc-pcomplete.el (pcomplete-erc-setup): Use `completion-ignore-case' instead (bug#23117). * lisp/pcomplete.el (pcomplete-ignore-case): Make obsolete. --- etc/NEWS | 2 ++ lisp/erc/erc-pcomplete.el | 2 +- lisp/eshell/em-cmpl.el | 6 +++--- lisp/pcomplete.el | 15 ++++++--------- 4 files changed, 12 insertions(+), 13 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 513004885cb..52e9ab0b1d7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2056,6 +2056,8 @@ directory instead of the default directory. * Incompatible Lisp Changes in Emacs 28.1 +** 'pcomplete-ignore-case' is now an obsolete alias of 'completion-ignore-case'. + ** 'completions-annotations' face is not used when the caller puts own face. This affects the suffix specified by completion 'annotation-function'. diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index ab4c7c580c6..ddaf78774a6 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -89,7 +89,7 @@ for use on `completion-at-point-function'." (defun pcomplete-erc-setup () "Setup `erc-mode' to use pcomplete." - (setq-local pcomplete-ignore-case t) + (setq-local completion-ignore-case t) (setq-local pcomplete-use-paring nil) (setq-local pcomplete-parse-arguments-function #'pcomplete-erc-parse-arguments) diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 638c0ac230a..cbfe0b81545 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -150,8 +150,8 @@ to writing a completion function." :type (get 'pcomplete-dir-ignore 'custom-type)) (defcustom eshell-cmpl-ignore-case (eshell-under-windows-p) - (eshell-cmpl--custom-variable-docstring 'pcomplete-ignore-case) - :type (get 'pcomplete-ignore-case 'custom-type)) + (eshell-cmpl--custom-variable-docstring 'completion-ignore-case) + :type (get 'completion-ignore-case 'custom-type)) (defcustom eshell-cmpl-autolist nil (eshell-cmpl--custom-variable-docstring 'pcomplete-autolist) @@ -259,7 +259,7 @@ to writing a completion function." eshell-cmpl-file-ignore) (setq-local pcomplete-dir-ignore eshell-cmpl-dir-ignore) - (setq-local pcomplete-ignore-case + (setq-local completion-ignore-case eshell-cmpl-ignore-case) (setq-local pcomplete-autolist eshell-cmpl-autolist) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 7effb27af7f..b648ecf0986 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -135,11 +135,8 @@ "A regexp of names to be disregarded during directory completion." :type '(choice regexp (const :tag "None" nil))) -(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin)) - ;; FIXME: the doc mentions file-name completion, but the code - ;; seems to apply it to all completions. - "If non-nil, ignore case when doing filename completion." - :type 'boolean) +(define-obsolete-variable-alias 'pcomplete-ignore-case 'completion-ignore-case + "28.1") (defcustom pcomplete-autolist nil "If non-nil, automatically list possibilities on partial completion. @@ -472,7 +469,7 @@ Same as `pcomplete' but using the standard completion UI." (not (member (funcall norm-func (directory-file-name f)) seen))))))) - (when pcomplete-ignore-case + (when completion-ignore-case (setq table (completion-table-case-fold table))) (list beg (point) table :predicate pred @@ -865,7 +862,7 @@ this is `comint-dynamic-complete-functions'." (sort comps pcomplete-compare-entry-function))) ,@(cdr (completion-file-name-table s p a))) (let ((completion-ignored-extensions nil) - (completion-ignore-case pcomplete-ignore-case)) + (completion-ignore-case completion-ignore-case)) (completion-table-with-predicate #'comint-completion-file-name-table pred 'strict s p a)))))) @@ -1116,7 +1113,7 @@ Typing SPC flushes the help buffer." "Insert a completion entry at point. Returns non-nil if a space was appended at the end." (let ((here (point))) - (if (not pcomplete-ignore-case) + (if (not completion-ignore-case) (insert-and-inherit (if raw-p (substring entry (length stub)) (comint-quote-filename @@ -1194,7 +1191,7 @@ Returns `partial' if completed as far as possible with the matches. Returns `listed' if a completion listing was shown. See also `pcomplete-filename'." - (let* ((completion-ignore-case pcomplete-ignore-case) + (let* ((completion-ignore-case completion-ignore-case) (completions (all-completions stub candidates)) (entry (try-completion stub candidates)) result) From 69d3a6c90f9bafdc4742097d1828ed7204aa12e0 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Tue, 9 Feb 2021 09:41:13 +0000 Subject: [PATCH 074/297] Allow exit-minibuffer to be called from Lisp code. Fixes bug #46373 * lisp/minibuffer.el (exit-minibuffer): Throw the error "Not in most nested minibuffer" only when the current buffer is a minibuffer (thus the command came directly from a key binding). * doc/lispref/minibuf.texi (Minibuffer Commands): Change the documentation accordingly. --- doc/lispref/minibuf.texi | 2 +- lisp/minibuffer.el | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 185d355ba70..b60775d4575 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2393,7 +2393,7 @@ minibuffer. @deffn Command exit-minibuffer This command exits the active minibuffer. It is normally bound to keys in minibuffer local keymaps. The command throws an error if the -current buffer is not the active minibuffer. +current buffer is a minibuffer, but not the active minibuffer. @end deffn @deffn Command self-insert-and-exit diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 03cc70c0d4d..a899a943d4c 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2116,13 +2116,15 @@ variables.") (defun exit-minibuffer () "Terminate this minibuffer argument." (interactive) + (when (or + (innermost-minibuffer-p) + (not (minibufferp))) ;; If the command that uses this has made modifications in the minibuffer, ;; we don't want them to cause deactivation of the mark in the original ;; buffer. ;; A better solution would be to make deactivate-mark buffer-local ;; (or to turn it into a list of buffers, ...), but in the mean time, ;; this should do the trick in most cases. - (when (innermost-minibuffer-p) (setq deactivate-mark nil) (throw 'exit nil)) (error "%s" "Not in most nested minibuffer")) From 1c326dfc1ce79bcbcfe9d7ad904e2184d4a691c4 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 9 Feb 2021 12:50:36 +0000 Subject: [PATCH 075/297] ; Finish customize-changed-options obsoletion --- etc/NEWS | 2 +- test/lisp/cus-edit-tests.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 52e9ab0b1d7..ec574543d11 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -916,7 +916,7 @@ To revert to the previous behavior, *** 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 -'customize-changed-options'. +'customize-changed'. To customize obsolete user options, use 'customize-option' or 'customize-saved'. diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 95f62e0d7ea..97b3349000c 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -53,9 +53,9 @@ (customize-apropos "cus-edit-tests") (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t)))) -(ert-deftest cus-edit-tests-customize-changed-options/hide-obsolete () +(ert-deftest cus-edit-tests-customize-changed/hide-obsolete () (with-cus-edit-test "*Customize Changed Options*" - (customize-changed-options "917.2") ; some future version + (customize-changed "917.2") ;; Some future version. (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t)))) (ert-deftest cus-edit-tests-customize-group/hide-obsolete () From 8e3ace4297512d9f1a2825d332b7e70c6ae3ea15 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 9 Feb 2021 13:00:56 +0000 Subject: [PATCH 076/297] ; Fix recent change in eval-last-sexp --- lisp/progmodes/elisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 0325d4ea756..312153052d6 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1268,7 +1268,7 @@ If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") (if (null eval-expression-debug-on-error) - (values--store-values + (values--store-value (elisp--eval-last-sexp eval-last-sexp-arg-internal)) (let ((value (let ((debug-on-error elisp--eval-last-sexp-fake-value)) From 627a02467508140d213a68c9eed6cb78a5e94860 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Feb 2021 16:28:30 +0100 Subject: [PATCH 077/297] Note that the `values' variable is now obsolete * src/lread.c (syms_of_lread): Note that it's obsolete in the doc string (because we can't mark it as obsolete "properly" yet, because that leads to compilation warnings when somebody (let (values) ... values). --- etc/NEWS | 2 ++ src/lread.c | 3 ++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index ec574543d11..7f02f6106d6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2217,6 +2217,8 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 +** The 'values' variable is now obsolete. + --- ** New variable 'indent-line-ignored-functions'. This allows modes to cycle through a set of indentation functions diff --git a/src/lread.c b/src/lread.c index 010194c34ea..dea1b232fff 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4833,7 +4833,8 @@ to find all the symbols in an obarray, use `mapatoms'. */); DEFVAR_LISP ("values", Vvalues, doc: /* List of values of all expressions which were read, evaluated and printed. -Order is reverse chronological. */); +Order is reverse chronological. +This variable is obsolete as of Emacs 28.1 and should not be used. */); XSYMBOL (intern ("values"))->u.s.declared_special = false; DEFVAR_LISP ("standard-input", Vstandard_input, From 0161c9df6edc02db6bd8871b00df522dd0699157 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 9 Feb 2021 15:58:37 +0100 Subject: [PATCH 078/297] Load all generic-x.el modes unconditionally * lisp/generic-x.el: Load all modes unconditionally. (generic-default-modes, generic-mswindows-modes) (generic-unix-modes, generic-other-modes) (generic-extras-enable-list): Make obsolete. Ref: https://lists.gnu.org/r/emacs-devel/2021-01/msg01403.html --- etc/NEWS | 5 + lisp/generic-x.el | 337 +++++++++++++++++----------------------------- 2 files changed, 132 insertions(+), 210 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7f02f6106d6..5325e87ccf3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2113,6 +2113,11 @@ parameter. 'previous-system-time-locale' have been removed, as they were created by mistake and were not useful to Lisp code. +--- +** Loading 'generic-x' unconditionally loads all modes. +The user option `generic-extras-enable-list' is now obsolete, and +setting it has no effect. + --- ** The 'load-dangerous-libraries' variable is now obsolete. It was used to allow loading Lisp libraries compiled by XEmacs, a diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 4c6e1189003..0f4e1ae4a6e 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -23,7 +23,7 @@ ;; along with GNU Emacs. If not, see . ;;; Commentary: -;; + ;; This file contains a collection of generic modes. ;; ;; INSTALLATION: @@ -32,17 +32,6 @@ ;; ;; (require 'generic-x) ;; -;; You can decide which modes to load by setting the variable -;; `generic-extras-enable-list'. Its default value is platform- -;; specific. The recommended way to set this variable is through -;; customize: -;; -;; M-x customize-option RET generic-extras-enable-list RET -;; -;; This lets you select generic modes from the list of available -;; modes. If you manually set `generic-extras-enable-list' in your -;; .emacs, do it BEFORE loading generic-x with (require 'generic-x). -;; ;; You can also send in new modes; if the file types are reasonably ;; common, we would like to install them. ;; @@ -184,88 +173,7 @@ This hook will be installed if the variable ;; Other Generic modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; If you add a generic mode to this file, put it in one of these four -;; lists as well. - -(defconst generic-default-modes - '(apache-conf-generic-mode - apache-log-generic-mode - hosts-generic-mode - java-manifest-generic-mode - java-properties-generic-mode - javascript-generic-mode - show-tabs-generic-mode - vrml-generic-mode) - "List of generic modes that are defined by default.") - -(defconst generic-mswindows-modes - '(bat-generic-mode - inf-generic-mode - ini-generic-mode - rc-generic-mode - reg-generic-mode - rul-generic-mode) - "List of generic modes that are defined by default on MS-Windows.") - -(defconst generic-unix-modes - '(alias-generic-mode - ansible-inventory-generic-mode - etc-fstab-generic-mode - etc-modules-conf-generic-mode - etc-passwd-generic-mode - etc-services-generic-mode - etc-sudoers-generic-mode - fvwm-generic-mode - inetd-conf-generic-mode - mailagent-rules-generic-mode - mailrc-generic-mode - named-boot-generic-mode - named-database-generic-mode - prototype-generic-mode - resolve-conf-generic-mode - samba-generic-mode - x-resource-generic-mode - xmodmap-generic-mode) - "List of generic modes that are defined by default on Unix.") - -(defconst generic-other-modes - '(astap-generic-mode - ibis-generic-mode - pkginfo-generic-mode - spice-generic-mode) - "List of generic modes that are not defined by default.") - -(defcustom generic-extras-enable-list - (append generic-default-modes - (if (memq system-type '(windows-nt ms-dos)) - generic-mswindows-modes - generic-unix-modes) - nil) - "List of generic modes to define. -Each entry in the list should be a symbol. If you set this variable -directly, without using customize, you must reload generic-x to put -your changes into effect." - :type (let (list) - (dolist (mode - (sort (append generic-default-modes - generic-mswindows-modes - generic-unix-modes - generic-other-modes - nil) - (lambda (a b) - (string< (symbol-name b) - (symbol-name a)))) - (cons 'set list)) - (push `(const ,mode) list))) - :set (lambda (s v) - (set-default s v) - (unless load-in-progress - (load "generic-x"))) - :version "22.1") - ;;; Apache -(when (memq 'apache-conf-generic-mode generic-extras-enable-list) - (define-generic-mode apache-conf-generic-mode '(?#) nil @@ -278,9 +186,7 @@ your changes into effect." '((nil "^\\([-A-Za-z0-9_]+\\)" 1) ("*Directories*" "^\\s-*]+\\)>" 1) ("*Locations*" "^\\s-*]+\\)>" 1))))) - "Generic mode for Apache or HTTPD configuration files.")) - -(when (memq 'apache-log-generic-mode generic-extras-enable-list) + "Generic mode for Apache or HTTPD configuration files.") (define-generic-mode apache-log-generic-mode nil @@ -291,11 +197,9 @@ your changes into effect." (2 font-lock-variable-name-face))) '("access_log\\'") nil - "Generic mode for Apache log files.")) + "Generic mode for Apache log files.") ;;; Samba -(when (memq 'samba-generic-mode generic-extras-enable-list) - (define-generic-mode samba-generic-mode '(?\; ?#) nil @@ -305,13 +209,11 @@ your changes into effect." (2 font-lock-type-face))) '("smb\\.conf\\'") '(generic-bracket-support) - "Generic mode for Samba configuration files.")) + "Generic mode for Samba configuration files.") ;;; Fvwm ;; This is pretty basic. Also, modes for other window managers could ;; be defined as well. -(when (memq 'fvwm-generic-mode generic-extras-enable-list) - (define-generic-mode fvwm-generic-mode '(?#) '("AddToMenu" @@ -330,33 +232,28 @@ your changes into effect." nil '("\\.fvwmrc\\'" "\\.fvwm2rc\\'") nil - "Generic mode for FVWM configuration files.")) + "Generic mode for FVWM configuration files.") ;;; X Resource ;; I'm pretty sure I've seen an actual mode to do this, but I don't ;; think it's standard with Emacs -(when (memq 'x-resource-generic-mode generic-extras-enable-list) - (define-generic-mode x-resource-generic-mode '(?!) nil '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face)) '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'") nil - "Generic mode for X Resource configuration files.")) + "Generic mode for X Resource configuration files.") -(if (memq 'xmodmap-generic-mode generic-extras-enable-list) (define-generic-mode xmodmap-generic-mode '(?!) '("add" "clear" "keycode" "keysym" "remove" "pointer") nil '("[xX]modmap\\(rc\\)?\\'") nil - "Simple mode for xmodmap files.")) + "Simple mode for xmodmap files.") ;;; Hosts -(when (memq 'hosts-generic-mode generic-extras-enable-list) - (define-generic-mode hosts-generic-mode '(?#) '("localhost") @@ -364,27 +261,20 @@ your changes into effect." ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face)) '("[hH][oO][sS][tT][sS]\\'") nil - "Generic mode for HOSTS files.")) + "Generic mode for HOSTS files.") ;;; Windows INF files -;; If i-g-m-f-f-h is defined, then so is i-g-m. -(declare-function ini-generic-mode "generic-x") - -(when (memq 'inf-generic-mode generic-extras-enable-list) - (define-generic-mode inf-generic-mode '(?\;) nil '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face)) '("\\.[iI][nN][fF]\\'") '(generic-bracket-support) - "Generic mode for MS-Windows INF files.")) + "Generic mode for MS-Windows INF files.") ;;; Windows INI files ;; Should define escape character as well! -(when (memq 'ini-generic-mode generic-extras-enable-list) - (define-generic-mode ini-generic-mode '(?\;) nil @@ -411,13 +301,9 @@ like an INI file. You can add this hook to `find-file-hook'." (goto-char (point-min)) (and (looking-at "^\\s-*\\[.*\\]") (ini-generic-mode))))) -(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook - 'ini-generic-mode-find-file-hook "28.1")) ;;; Windows REG files ;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax! -(when (memq 'reg-generic-mode generic-extras-enable-list) - (define-generic-mode reg-generic-mode '(?\;) '("key" "classes_root" "REGEDIT" "REGEDIT4") @@ -428,19 +314,11 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))) - "Generic mode for MS-Windows Registry files.")) - -(declare-function w32-shell-name "w32-fns" ()) - -;;; DOS/Windows BAT files -(when (memq 'bat-generic-mode generic-extras-enable-list) - (define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4")) + "Generic mode for MS-Windows Registry files.") ;;; Mailagent ;; Mailagent is a Unix mail filtering program. Anyone wanna do a ;; generic mode for procmail? -(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list) - (define-generic-mode mailagent-rules-generic-mode '(?#) '("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT") @@ -451,11 +329,9 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))) - "Generic mode for Mailagent rules files.")) + "Generic mode for Mailagent rules files.") ;; Solaris/Sys V prototype files -(when (memq 'prototype-generic-mode generic-extras-enable-list) - (define-generic-mode prototype-generic-mode '(?#) nil @@ -474,11 +350,9 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("prototype\\'") nil - "Generic mode for Sys V prototype files.")) + "Generic mode for Sys V prototype files.") ;; Solaris/Sys V pkginfo files -(when (memq 'pkginfo-generic-mode generic-extras-enable-list) - (define-generic-mode pkginfo-generic-mode '(?#) nil @@ -487,17 +361,9 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("pkginfo\\'") nil - "Generic mode for Sys V pkginfo files.")) - -;; Javascript mode -;; Obsolete; defer to js-mode from js.el. -(when (memq 'javascript-generic-mode generic-extras-enable-list) - (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3") - (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")) + "Generic mode for Sys V pkginfo files.") ;; VRML files -(when (memq 'vrml-generic-mode generic-extras-enable-list) - (define-generic-mode vrml-generic-mode '(?#) '("DEF" @@ -545,11 +411,9 @@ like an INI file. You can add this hook to `find-file-hook'." ("*Definitions*" "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" 1))))) - "Generic Mode for VRML files.")) + "Generic Mode for VRML files.") ;; Java Manifests -(when (memq 'java-manifest-generic-mode generic-extras-enable-list) - (define-generic-mode java-manifest-generic-mode '(?#) '("Name" @@ -566,11 +430,9 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-constant-face))) '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") nil - "Generic mode for Java Manifest files.")) + "Generic mode for Java Manifest files.") ;; Java properties files -(when (memq 'java-properties-generic-mode generic-extras-enable-list) - (define-generic-mode java-properties-generic-mode '(?! ?#) nil @@ -596,11 +458,9 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))) - "Generic mode for Java properties files.")) + "Generic mode for Java properties files.") ;; C shell alias definitions -(when (memq 'alias-generic-mode generic-extras-enable-list) - (define-generic-mode alias-generic-mode '(?#) '("alias" "unalias") @@ -613,11 +473,9 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))) - "Generic mode for C Shell alias files.")) + "Generic mode for C Shell alias files.") ;; Ansible inventory files -(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list) - (define-generic-mode ansible-inventory-generic-mode '(?#) nil @@ -636,12 +494,10 @@ like an INI file. You can add this hook to `find-file-hook'." (setq imenu-generic-expression '((nil "^\\s-*\\[\\(.*\\)\\]" 1) ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))) - "Generic mode for Ansible inventory files.")) + "Generic mode for Ansible inventory files.") ;;; Windows RC files ;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira) -(when (memq 'rc-generic-mode generic-extras-enable-list) - (define-generic-mode rc-generic-mode ;; '(?\/) '("//") @@ -721,15 +577,13 @@ like an INI file. You can add this hook to `find-file-hook'." '("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)))) - '("\\.[rR][cC]\\'") - nil - "Generic mode for MS-Windows Resource files.")) + '("\\.[rR][cC]\\'") + nil + "Generic mode for MS-Windows Resource files.") ;; InstallShield RUL files ;; Contributed by Alfred.Correira@Pervasive.Com ;; Bugfixes by "Rolf Sandau" -(when (memq 'rul-generic-mode generic-extras-enable-list) - (eval-when-compile ;;; build the regexp strings using regexp-opt @@ -1372,11 +1226,9 @@ like an INI file. You can add this hook to `find-file-hook'." > "begin" \n > _ \n resume: - > "end;")) + > "end;") ;; Additions by ACorreir@pervasive-sw.com (Alfred Correira) -(when (memq 'mailrc-generic-mode generic-extras-enable-list) - (define-generic-mode mailrc-generic-mode '(?#) '("alias" @@ -1398,11 +1250,9 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("\\.mailrc\\'") nil - "Mode for mailrc files.")) + "Mode for mailrc files.") ;; Inetd.conf -(when (memq 'inetd-conf-generic-mode generic-extras-enable-list) - (define-generic-mode inetd-conf-generic-mode '(?#) '("stream" @@ -1417,11 +1267,9 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) ;; Services -(when (memq 'etc-services-generic-mode generic-extras-enable-list) - (define-generic-mode etc-services-generic-mode '(?#) '("tcp" @@ -1434,11 +1282,9 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) ;; Password and Group files -(when (memq 'etc-passwd-generic-mode generic-extras-enable-list) - (define-generic-mode etc-passwd-generic-mode nil ;; No comment characters '("root") ;; Only one keyword @@ -1476,11 +1322,9 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))) + '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))) ;; Fstab -(when (memq 'etc-fstab-generic-mode generic-extras-enable-list) - (define-generic-mode etc-fstab-generic-mode '(?#) '("adfs" @@ -1592,11 +1436,9 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([^# \t]+\\)\\s-+" 1))))))) + '((nil "^\\([^# \t]+\\)\\s-+" 1)))))) ;; /etc/sudoers -(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list) - (define-generic-mode etc-sudoers-generic-mode '(?#) '("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias" @@ -1607,11 +1449,9 @@ like an INI file. You can add this hook to `find-file-hook'." ("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face)) '("/etc/sudoers\\'") nil - "Generic mode for sudoers configuration files.")) + "Generic mode for sudoers configuration files.") ;; From Jacques Duthen -(when (memq 'show-tabs-generic-mode generic-extras-enable-list) - (eval-when-compile (defconst show-tabs-generic-mode-font-lock-defaults-1 @@ -1649,14 +1489,12 @@ like an INI file. You can add this hook to `find-file-hook'." nil ;; no auto-mode-alist ;; '(show-tabs-generic-mode-hook-fun) nil - "Generic mode to show tabs and trailing spaces.")) + "Generic mode to show tabs and trailing spaces.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DNS modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(when (memq 'named-boot-generic-mode generic-extras-enable-list) - (define-generic-mode named-boot-generic-mode ;; List of comment characters '(?\;) @@ -1672,9 +1510,7 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional automode-alist expressions '("/etc/named\\.boot\\'") ;; List of set up functions to call - nil)) - -(when (memq 'named-database-generic-mode generic-extras-enable-list) + nil) (define-generic-mode named-database-generic-mode ;; List of comment characters @@ -1695,9 +1531,7 @@ like an INI file. You can add this hook to `find-file-hook'." (defun named-database-print-serial () "Print a serial number based on the current date." (interactive) - (insert (format-time-string named-database-time-string)))) - -(when (memq 'resolve-conf-generic-mode generic-extras-enable-list) + (insert (format-time-string named-database-time-string))) (define-generic-mode resolve-conf-generic-mode ;; List of comment characters @@ -1709,14 +1543,12 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional auto-mode-alist expressions '("/etc/resolve?\\.conf\\'") ;; List of set up functions to call - nil)) + nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modes for spice and common electrical engineering circuit netlist formats ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(when (memq 'spice-generic-mode generic-extras-enable-list) - (define-generic-mode spice-generic-mode nil '("and" @@ -1752,9 +1584,7 @@ like an INI file. You can add this hook to `find-file-hook'." ;; Make keywords case-insensitive (lambda () (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) - "Generic mode for SPICE circuit netlist files.")) - -(when (memq 'ibis-generic-mode generic-extras-enable-list) + "Generic mode for SPICE circuit netlist files.") (define-generic-mode ibis-generic-mode '(?|) @@ -1763,9 +1593,7 @@ like an INI file. You can add this hook to `find-file-hook'." ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face)) '("\\.[iI][bB][sS]\\'") '(generic-bracket-support) - "Generic mode for IBIS circuit netlist files.")) - -(when (memq 'astap-generic-mode generic-extras-enable-list) + "Generic mode for IBIS circuit netlist files.") (define-generic-mode astap-generic-mode nil @@ -1799,9 +1627,7 @@ like an INI file. You can add this hook to `find-file-hook'." ;; Make keywords case-insensitive (lambda () (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) - "Generic mode for ASTAP circuit netlist files.")) - -(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list) + "Generic mode for ASTAP circuit netlist files.") (define-generic-mode etc-modules-conf-generic-mode ;; List of comment characters @@ -1843,7 +1669,98 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional automode-alist expressions '("/etc/modules\\.conf" "/etc/conf\\.modules") ;; List of set up functions to call - nil)) + nil) + +;; Obsolete + +(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3") +(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3") + +(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4") + +(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook + #'ini-generic-mode-find-file-hook "28.1") + +(defconst generic-default-modes + '(apache-conf-generic-mode + apache-log-generic-mode + hosts-generic-mode + java-manifest-generic-mode + java-properties-generic-mode + javascript-generic-mode + show-tabs-generic-mode + vrml-generic-mode) + "List of generic modes that are defined by default.") +(make-obsolete-variable 'generic-default-modes "no longer used." "28.1") + +(defconst generic-mswindows-modes + '(bat-generic-mode + inf-generic-mode + ini-generic-mode + rc-generic-mode + reg-generic-mode + rul-generic-mode) + "List of generic modes that are defined by default on MS-Windows.") +(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1") + +(defconst generic-unix-modes + '(alias-generic-mode + ansible-inventory-generic-mode + etc-fstab-generic-mode + etc-modules-conf-generic-mode + etc-passwd-generic-mode + etc-services-generic-mode + etc-sudoers-generic-mode + fvwm-generic-mode + inetd-conf-generic-mode + mailagent-rules-generic-mode + mailrc-generic-mode + named-boot-generic-mode + named-database-generic-mode + prototype-generic-mode + resolve-conf-generic-mode + samba-generic-mode + x-resource-generic-mode + xmodmap-generic-mode) + "List of generic modes that are defined by default on Unix.") +(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1") + +(defconst generic-other-modes + '(astap-generic-mode + ibis-generic-mode + pkginfo-generic-mode + spice-generic-mode) + "List of generic modes that are not defined by default.") +(make-obsolete-variable 'generic-other-modes "no longer used." "28.1") + +(defcustom generic-extras-enable-list + (append generic-default-modes + (if (memq system-type '(windows-nt ms-dos)) + generic-mswindows-modes + generic-unix-modes) + nil) + "List of generic modes to define. +Each entry in the list should be a symbol. If you set this variable +directly, without using customize, you must reload generic-x to put +your changes into effect." + :type (let (list) + (dolist (mode + (sort (append generic-default-modes + generic-mswindows-modes + generic-unix-modes + generic-other-modes + nil) + (lambda (a b) + (string< (symbol-name b) + (symbol-name a)))) + (cons 'set list)) + (push `(const ,mode) list))) + :set (lambda (s v) + (set-default s v) + (unless load-in-progress + (load "generic-x"))) + :version "22.1") +(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1") (provide 'generic-x) From 3c53d28ae19232ae817565453342edf8124c053a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 9 Feb 2021 16:57:27 +0100 Subject: [PATCH 079/297] Remove some dead, commented out code from lisp-mode.el * lisp/emacs-lisp/lisp-mode.el (lisp-data-mode-syntax-table): Remove code commented out since 2005. --- lisp/emacs-lisp/lisp-mode.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index f5ce107185a..54089c4bc69 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -62,9 +62,6 @@ (modify-syntax-entry ?\t " " table) (modify-syntax-entry ?\f " " table) (modify-syntax-entry ?\n "> " table) - ;; This is probably obsolete since nowadays such features use overlays. - ;; ;; Give CR the same syntax as newline, for selective-display. - ;; (modify-syntax-entry ?\^m "> " table) (modify-syntax-entry ?\; "< " table) (modify-syntax-entry ?` "' " table) (modify-syntax-entry ?' "' " table) From 04fb1664a8ee3c20ed8a231ce5c9bb05a145f8e0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Feb 2021 12:02:25 -0500 Subject: [PATCH 080/297] * lisp/emacs-lisp/macroexp.el: Break cycle with bytecomp/byte-opt The recent change in macroexp triggered a cyclic dependency error during eager macroexpansion when neither `bytecomp` nor `byte-opt` had been byte-compiled yet. This fixes it by moving the offending function to macroexp.el. * lisp/emacs-lisp/macroexp.el (macroexp--unfold-lambda): Move from byte-opt.el and rename. (macroexp--expand-all): Use it. * lisp/emacs-lisp/byte-opt.el (byte-compile-unfold-lambda): Move to macroexp.el. (byte-compile-inline-expand, byte-optimize-form-code-walker): * lisp/emacs-lisp/bytecomp.el (byte-compile-form): Use `macroexp--unfold-lambda` instead. --- lisp/emacs-lisp/byte-opt.el | 72 ++----------------------------------- lisp/emacs-lisp/bytecomp.el | 3 +- lisp/emacs-lisp/macroexp.el | 71 ++++++++++++++++++++++++++++++++---- 3 files changed, 68 insertions(+), 78 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index abbe2a2e63f..e67077639c2 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -289,7 +289,7 @@ (byte-compile-preprocess (byte-compile--reify-function fn)))))) (if (eq (car-safe newfn) 'function) - (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + (macroexp--unfold-lambda `(,(cadr newfn) ,@(cdr form))) ;; This can happen because of macroexp-warn-and-return &co. (byte-compile-warn "Inlining closure %S failed" name) @@ -297,74 +297,6 @@ (_ ;; Give up on inlining. form)))) - -;; ((lambda ...) ...) -(defun byte-compile-unfold-lambda (form &optional name) - ;; In lexical-binding mode, let and functions don't bind vars in the same way - ;; (let obey special-variable-p, but functions don't). But luckily, this - ;; doesn't matter here, because function's behavior is underspecified so it - ;; can safely be turned into a `let', even though the reverse is not true. - (or name (setq name "anonymous lambda")) - (let* ((lambda (car form)) - (values (cdr form)) - (arglist (nth 1 lambda)) - (body (cdr (cdr lambda))) - optionalp restp - bindings) - (if (and (stringp (car body)) (cdr body)) - (setq body (cdr body))) - (if (and (consp (car body)) (eq 'interactive (car (car body)))) - (setq body (cdr body))) - ;; FIXME: The checks below do not belong in an optimization phase. - (while arglist - (cond ((eq (car arglist) '&optional) - ;; ok, I'll let this slide because funcall_lambda() does... - ;; (if optionalp (error "multiple &optional keywords in %s" name)) - (if restp (error "&optional found after &rest in %s" name)) - (if (null (cdr arglist)) - (error "nothing after &optional in %s" name)) - (setq optionalp t)) - ((eq (car arglist) '&rest) - ;; ...but it is by no stretch of the imagination a reasonable - ;; thing that funcall_lambda() allows (&rest x y) and - ;; (&rest x &optional y) in arglists. - (if (null (cdr arglist)) - (error "nothing after &rest in %s" name)) - (if (cdr (cdr arglist)) - (error "multiple vars after &rest in %s" name)) - (setq restp t)) - (restp - (setq bindings (cons (list (car arglist) - (and values (cons 'list values))) - bindings) - values nil)) - ((and (not optionalp) (null values)) - (byte-compile-warn "attempt to open-code `%s' with too few arguments" name) - (setq arglist nil values 'too-few)) - (t - (setq bindings (cons (list (car arglist) (car values)) - bindings) - values (cdr values)))) - (setq arglist (cdr arglist))) - (if values - (progn - (or (eq values 'too-few) - (byte-compile-warn - "attempt to open-code `%s' with too many arguments" name)) - form) - - ;; The following leads to infinite recursion when loading a - ;; file containing `(defsubst f () (f))', and then trying to - ;; byte-compile that file. - ;(setq body (mapcar 'byte-optimize-form body))) - - (let ((newform - (if bindings - (cons 'let (cons (nreverse bindings) body)) - (cons 'progn body)))) - (byte-compile-log " %s\t==>\t%s" form newform) - newform)))) - ;;; implementing source-level optimizers @@ -604,7 +536,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") form) (`((lambda . ,_) . ,_) - (let ((newform (byte-compile-unfold-lambda form))) + (let ((newform (macroexp--unfold-lambda form))) (if (eq newform form) ;; Some error occurred, avoid infinite recursion. form diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 9429d6a0d5d..89068a14f02 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -195,7 +195,6 @@ otherwise adds \".elc\"." (autoload 'byte-optimize-form "byte-opt") ;; This is the entry point to the lapcode optimizer pass2. (autoload 'byte-optimize-lapcode "byte-opt") -(autoload 'byte-compile-unfold-lambda "byte-opt") ;; This is the entry point to the decompiler, which is used by the ;; disassembler. The disassembler just requires 'byte-compile, but @@ -3277,7 +3276,7 @@ for symbols generated by the byte compiler itself." ((and (eq (car-safe (car form)) 'lambda) ;; if the form comes out the same way it went in, that's ;; because it was malformed, and we couldn't unfold it. - (not (eq form (setq form (byte-compile-unfold-lambda form))))) + (not (eq form (setq form (macroexp--unfold-lambda form))))) (byte-compile-form form byte-compile--for-effect) (setq byte-compile--for-effect nil)) ((byte-compile-normal-call form))) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e842222b7c3..042061c44fc 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -200,6 +200,69 @@ and also to avoid outputting the warning during normal execution." new-form)) new-form))) +(defun macroexp--unfold-lambda (form &optional name) + ;; In lexical-binding mode, let and functions don't bind vars in the same way + ;; (let obey special-variable-p, but functions don't). But luckily, this + ;; doesn't matter here, because function's behavior is underspecified so it + ;; can safely be turned into a `let', even though the reverse is not true. + (or name (setq name "anonymous lambda")) + (let* ((lambda (car form)) + (values (cdr form)) + (arglist (nth 1 lambda)) + (body (cdr (cdr lambda))) + optionalp restp + bindings) + (if (and (stringp (car body)) (cdr body)) + (setq body (cdr body))) + (if (and (consp (car body)) (eq 'interactive (car (car body)))) + (setq body (cdr body))) + ;; FIXME: The checks below do not belong in an optimization phase. + (while arglist + (cond ((eq (car arglist) '&optional) + ;; ok, I'll let this slide because funcall_lambda() does... + ;; (if optionalp (error "multiple &optional keywords in %s" name)) + (if restp (error "&optional found after &rest in %s" name)) + (if (null (cdr arglist)) + (error "nothing after &optional in %s" name)) + (setq optionalp t)) + ((eq (car arglist) '&rest) + ;; ...but it is by no stretch of the imagination a reasonable + ;; thing that funcall_lambda() allows (&rest x y) and + ;; (&rest x &optional y) in arglists. + (if (null (cdr arglist)) + (error "nothing after &rest in %s" name)) + (if (cdr (cdr arglist)) + (error "multiple vars after &rest in %s" name)) + (setq restp t)) + (restp + (setq bindings (cons (list (car arglist) + (and values (cons 'list values))) + bindings) + values nil)) + ((and (not optionalp) (null values)) + (setq arglist nil values 'too-few)) + (t + (setq bindings (cons (list (car arglist) (car values)) + bindings) + values (cdr values)))) + (setq arglist (cdr arglist))) + (if values + (macroexp--warn-and-return + (format (if (eq values 'too-few) + "attempt to open-code `%s' with too few arguments" + "attempt to open-code `%s' with too many arguments") + name) + form) + + ;; The following leads to infinite recursion when loading a + ;; file containing `(defsubst f () (f))', and then trying to + ;; byte-compile that file. + ;;(setq body (mapcar 'byte-optimize-form body))) + + (if bindings + `(let ,(nreverse bindings) . ,body) + (macroexp-progn body))))) + (defun macroexp--expand-all (form) "Expand all macros in FORM. This is an internal version of `macroexpand-all'. @@ -245,12 +308,8 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; i.e. rewrite it to (let () ). We'd do it in the optimizer ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the ;; creation of a closure, thus resulting in much better code. - (let ((newform (if (not (fboundp 'byte-compile-unfold-lambda)) - 'macroexp--not-unfolded - ;; Don't unfold if byte-opt is not yet loaded. - (byte-compile-unfold-lambda form)))) - (if (or (eq newform 'macroexp--not-unfolded) - (eq newform form)) + (let ((newform (macroexp--unfold-lambda form))) + (if (eq newform form) ;; Unfolding failed for some reason, avoid infinite recursion. (macroexp--cons (macroexp--all-forms fun 2) (macroexp--all-forms args) From 6fd8548b1620aadd2c9e4efddd899b87d023913b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Feb 2021 12:10:07 -0500 Subject: [PATCH 081/297] * lisp/emacs-lisp/byte-opt.el (byte-optimize--pcase): New macro (byte-optimize-form-code-walker): Use it. --- lisp/emacs-lisp/byte-opt.el | 70 ++++++++++++++++++++++++++----------- 1 file changed, 50 insertions(+), 20 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index e67077639c2..4fa2c75a889 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -348,6 +348,40 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (symbolp (cadr expr))) (keywordp expr))) +(defmacro byte-optimize--pcase (exp &rest cases) + ;; When we do + ;; + ;; (pcase EXP + ;; (`(if ,exp ,then ,else) (DO-TEST)) + ;; (`(plus ,e2 ,e2) (DO-ADD)) + ;; (`(times ,e2 ,e2) (DO-MULT)) + ;; ...) + ;; + ;; we usually don't want to fall back to the default case if + ;; the value of EXP is of a form like `(if E1 E2)' or `(plus E1)' + ;; or `(times E1 E2 E3)', instead we either want to signal an error + ;; that EXP has an unexpected shape, or we want to carry on as if + ;; it had the right shape (ignore the extra data and pretend the missing + ;; data is nil) because it should simply never happen. + ;; + ;; The macro below implements the second option by rewriting patterns + ;; like `(if ,exp ,then ,else)' + ;; to `(if . (or `(,exp ,then ,else) pcase--dontcare))'. + ;; + ;; The resulting macroexpansion is also significantly cleaner/smaller/faster. + (declare (indent 1) (debug (form &rest (pcase-PAT body)))) + `(pcase ,exp + . ,(mapcar (lambda (case) + `(,(pcase (car case) + ((and `(,'\` (,_ . (,'\, ,_))) pat) pat) + (`(,'\` (,head . ,tail)) + (list '\` + (cons head + (list '\, `(or ,(list '\` tail) pcase--dontcare))))) + (pat pat)) + . ,(cdr case))) + cases))) + (defun byte-optimize-form-code-walker (form for-effect) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But @@ -360,7 +394,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; have no place in an optimizer: the corresponding tests should be ;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'. (let ((fn (car-safe form))) - (pcase form + (byte-optimize--pcase form ((pred (not consp)) (cond ((and for-effect @@ -370,7 +404,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") nil) ((symbolp form) (let ((lexvar (assq form byte-optimize--lexvars))) - (if (cddr lexvar) ; Value available? + (if (cddr lexvar) ; Value available? (if (assq form byte-optimize--vars-outside-loop) ;; Cannot substitute; mark for retention to avoid the ;; variable being eliminated. @@ -390,27 +424,27 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (not for-effect) form)) (`(,(or 'let 'let*) . ,rest) - (cons fn (byte-optimize-let-form fn rest for-effect))) + (cons fn (byte-optimize-let-form fn rest for-effect))) (`(cond . ,clauses) ;; The condition in the first clause is always executed, but ;; right now we treat all of them as conditional for simplicity. (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) (cons fn (mapcar (lambda (clause) - (if (consp clause) - (cons - (byte-optimize-form (car clause) nil) - (byte-optimize-body (cdr clause) for-effect)) - (byte-compile-warn "malformed cond form: `%s'" - (prin1-to-string clause)) - clause)) - clauses)))) + (if (consp clause) + (cons + (byte-optimize-form (car clause) nil) + (byte-optimize-body (cdr clause) for-effect)) + (byte-compile-warn "malformed cond form: `%s'" + (prin1-to-string clause)) + clause)) + clauses)))) (`(progn . ,exps) ;; As an extra added bonus, this simplifies (progn ) --> . (if (cdr exps) (macroexp-progn (byte-optimize-body exps for-effect)) (byte-optimize-form (car exps) for-effect))) - (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare)) + (`(prog1 ,exp . ,exps) (if exps `(prog1 ,(byte-optimize-form exp for-effect) . ,(byte-optimize-body exps t)) @@ -435,8 +469,6 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (then-opt (byte-optimize-form then for-effect)) (else-opt (byte-optimize-body else for-effect))) `(if ,test-opt ,then-opt . ,else-opt))) - (`(if . ,_) - (byte-compile-warn "too few arguments for `if'")) (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. ;; FIXME: We have to traverse the expressions in left-to-right @@ -474,8 +506,6 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (body (byte-optimize-body exps t))) `(while ,condition . ,body))) - (`(while . ,_) - (byte-compile-warn "too few arguments for `while'")) (`(interactive . ,_) (byte-compile-warn "misplaced interactive spec: `%s'" @@ -487,9 +517,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; all the subexpressions and compiling them separately. form) - (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare)) + (`(condition-case ,var ,exp . ,clauses) (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) - `(condition-case ,var ;Not evaluated. + `(condition-case ,var ;Not evaluated. ,(byte-optimize-form exp for-effect) ,@(mapcar (lambda (clause) `(,(car clause) @@ -513,7 +543,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") `(unwind-protect ,bodyform . ,(byte-optimize-body exps t)))))) - (`(catch . ,(or `(,tag . ,exps) pcase--dontcare)) + (`(catch ,tag . ,exps) (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) `(catch ,(byte-optimize-form tag nil) . ,(byte-optimize-body exps for-effect)))) @@ -566,7 +596,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (setcdr (cdr lexvar) (and (byte-optimize--substitutable-p value) (list value)))) - (setcar (cdr lexvar) t)) ; Mark variable to be kept. + (setcar (cdr lexvar) t)) ; Mark variable to be kept. (push var var-expr-list) (push value var-expr-list)) (setq args (cddr args))) From 5a77517e7dbe823554e9670564758c69cbd1796a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Feb 2021 12:52:04 -0500 Subject: [PATCH 082/297] * lisp/cedet/{semantic/scope.el,ede/project-am.el}: Use lexical-scoping * lisp/cedet/ede/project-am.el: Remove redundant `:group` args. (recentf-exclude): Declare variable. (project-am--with-makefile-current): New function extracted from `project-am-with-makefile-current`. Use `with-current-buffer` and `unwind-protect`. (project-am-with-makefile-current): Use `declare` and `project-am--with-makefile-current`. (project-am-with-config-current): Use `declare` and `with-temp-buffer`. (project-am-extract-shell-variable): Turn it into a `defun`; the use of `defmacro` appears to have been a plain mistake. --- lisp/cedet/ede/project-am.el | 107 ++++++++++++++--------------------- lisp/cedet/semantic/scope.el | 14 ++--- 2 files changed, 51 insertions(+), 70 deletions(-) diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 061d1b540b0..d676c5749c3 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -1,4 +1,4 @@ -;;; project-am.el --- A project management scheme based on automake files. +;;; project-am.el --- A project management scheme based on automake files. -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2000, 2003, 2005, 2007-2021 Free Software ;; Foundation, Inc. @@ -54,17 +54,14 @@ (defcustom project-am-compile-project-command nil "Default command used to compile a project." - :group 'project-am :type '(choice (const nil) string)) (defcustom project-am-compile-target-command (concat ede-make-command " -k %s") "Default command used to compile a project." - :group 'project-am :type 'string) (defcustom project-am-debug-target-function 'gdb "Default Emacs command used to debug a target." - :group 'project-am :type 'function) ; make this be a list some day (defconst project-am-type-alist @@ -240,8 +237,8 @@ OT is the object target. DIR is the directory to start in." (if (= (point-min) (point)) (re-search-forward (ede-target-name obj)))) -(cl-defmethod project-new-target ((proj project-am-makefile) - &optional name type) +(cl-defmethod project-new-target ((_proj project-am-makefile) + &optional name type) "Create a new target named NAME. Argument TYPE is the type of target to insert. This is a string matching something in `project-am-type-alist' or type class symbol. @@ -300,7 +297,7 @@ buffer being in order to provide a smart default target type." ;; This should be handled at the EDE level, calling a method of the ;; top most project. ;; -(cl-defmethod project-compile-project ((obj project-am-target) &optional command) +(cl-defmethod project-compile-project ((_obj project-am-target) &optional command) "Compile the entire current project. Argument COMMAND is the command to use when compiling." (require 'compile) @@ -324,7 +321,7 @@ Argument COMMAND is the command to use when compiling." (let* ((default-directory (project-am-find-topmost-level default-directory))) (compile command))) -(cl-defmethod project-compile-project ((obj project-am-makefile) +(cl-defmethod project-compile-project ((_obj project-am-makefile) &optional command) "Compile the entire current project. Argument COMMAND is the command to use when compiling." @@ -349,7 +346,7 @@ Argument COMMAND is the command to use when compiling." (let* ((default-directory (project-am-find-topmost-level default-directory))) (compile command))) -(cl-defmethod project-compile-target ((obj project-am-target) &optional command) +(cl-defmethod project-compile-target ((_obj project-am-target) &optional command) "Compile the current target. Argument COMMAND is the command to use for compiling the target." (require 'compile) @@ -423,7 +420,7 @@ Argument COMMAND is the command to use for compiling the target." ;;; Project loading and saving ;; -(defun project-am-load (directory &optional rootproj) +(defun project-am-load (directory &optional _rootproj) "Read an automakefile DIRECTORY into our data structure. If a given set of projects has already been loaded, then do nothing but return the project for the directory given. @@ -442,34 +439,28 @@ Optional ROOTPROJ is the root EDE project." (file-name-directory (directory-file-name newdir)))) (expand-file-name dir))) +(defvar recentf-exclude) + (defmacro project-am-with-makefile-current (dir &rest forms) "Set the Makefile.am in DIR to be the current buffer. -Run FORMS while the makefile is current. -Kill the makefile if it was not loaded before the load." - `(let* ((fn (expand-file-name "Makefile.am" ,dir)) - (fb nil) - (kb (get-file-buffer fn))) - (if (not (file-exists-p fn)) - nil - (save-excursion - (if kb (setq fb kb) - ;; We need to find-file this thing, but don't use - ;; any semantic features. - (let ((semantic-init-hook nil) - (recentf-exclude '( (lambda (f) t) )) - ) - (setq fb (find-file-noselect fn))) - ) - (set-buffer fb) - (prog1 ,@forms - (if (not kb) (kill-buffer (current-buffer)))))))) -(put 'project-am-with-makefile-current 'lisp-indent-function 1) - -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec project-am-with-makefile-current - (form def-body)))) +Run FORMS while the makefile is current." + (declare (indent 1) (debug (form def-body))) + `(project-am--with-makefile-current ,dir (lambda () ,@forms))) +(defun project-am--with-makefile-current (dir fun) + (let* ((fn (expand-file-name "Makefile.am" dir)) + (kb (get-file-buffer fn))) + (if (not (file-exists-p fn)) + nil + (with-current-buffer + (or kb + ;; We need to find-file this thing, but don't use + ;; any semantic features. + (let ((semantic-init-hook nil) + (recentf-exclude `(,(lambda (_f) t)))) + (find-file-noselect fn))) + (unwind-protect (funcall fun) + (if (not kb) (kill-buffer (current-buffer)))))))) (defun project-am-load-makefile (path &optional suggestedname) "Convert PATH into a project Makefile, and return its project object. @@ -480,6 +471,7 @@ This is used when subprojects are made in named subdirectories." (if (and ede-object (project-am-makefile-p ede-object)) ede-object (let* ((pi (project-am-package-info path)) + (fn buffer-file-name) (sfn (when suggestedname (project-am-last-dir suggestedname))) (pn (or sfn (nth 0 pi) (project-am-last-dir fn))) @@ -734,19 +726,19 @@ Strip out duplicates, and recurse on variables." "Return the default macro to `edit' for this object type." (concat (subst-char-in-string ?- ?_ (oref this name)) "_SOURCES")) -(cl-defmethod project-am-macro ((this project-am-header-noinst)) +(cl-defmethod project-am-macro ((_this project-am-header-noinst)) "Return the default macro to `edit' for this object." "noinst_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-inst)) +(cl-defmethod project-am-macro ((_this project-am-header-inst)) "Return the default macro to `edit' for this object." "include_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-pkg)) +(cl-defmethod project-am-macro ((_this project-am-header-pkg)) "Return the default macro to `edit' for this object." "pkginclude_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-chk)) +(cl-defmethod project-am-macro ((_this project-am-header-chk)) "Return the default macro to `edit' for this object." "check_HEADERS") @@ -758,7 +750,7 @@ Strip out duplicates, and recurse on variables." "Return the default macro to `edit' for this object type." (oref this name)) -(cl-defmethod project-am-macro ((this project-am-lisp)) +(cl-defmethod project-am-macro ((_this project-am-lisp)) "Return the default macro to `edit' for this object." "lisp_LISP") @@ -785,13 +777,11 @@ nil means that this buffer belongs to no-one." "Return t if object THIS lays claim to the file in BUFFER." (let ((efn (expand-file-name (buffer-file-name buffer)))) (or (string= (oref this file) efn) - (string-match "/configure\\.ac$" efn) - (string-match "/configure\\.in$" efn) - (string-match "/configure$" efn) + (string-match "/configure\\(?:\\.ac\\|\\.in\\)?\\'" efn) ;; Search output files. (let ((ans nil)) (dolist (f (oref this configureoutputfiles)) - (when (string-match (concat (regexp-quote f) "$") efn) + (when (string-match (concat (regexp-quote f) "\\'") efn) (setq ans t))) ans) ))) @@ -822,7 +812,7 @@ nil means that this buffer belongs to no-one." "Return the sub project in AMPF specified by SUBDIR." (object-assoc (expand-file-name subdir) 'file (oref ampf subproj))) -(cl-defmethod project-compile-target-command ((this project-am-target)) +(cl-defmethod project-compile-target-command ((_this project-am-target)) "Default target to use when compiling a given target." ;; This is a pretty good default for most. "") @@ -861,7 +851,7 @@ Argument FILE is the file to extract the end directory name from." (t 'project-am-program))) -(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer) +(cl-defmethod ede-buffer-header-file((this project-am-objectcode) _buffer) "There are no default header files." (or (cl-call-next-method) (let ((s (oref this source)) @@ -910,22 +900,13 @@ files in the project." "Set the Configure FILE in the top most directory above DIR as current. Run FORMS in the configure file. Kill the Configure buffer if it was not already in a buffer." - `(save-excursion - (let ((fb (generate-new-buffer ,file))) - (set-buffer fb) - (erase-buffer) - (insert-file-contents ,file) - (prog1 ,@forms - (kill-buffer fb))))) + (declare (indent 1) (debug t)) + `(with-temp-buffer + (erase-buffer) + (insert-file-contents ,file) + ,@forms)) -(put 'project-am-with-config-current 'lisp-indent-function 1) - -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec project-am-with-config-current - (form def-body)))) - -(defmacro project-am-extract-shell-variable (var) +(defun project-am-extract-shell-variable (var) "Extract the value of the shell variable VAR from a shell script." (save-excursion (goto-char (point-min)) @@ -997,12 +978,12 @@ Calculates the info with `project-am-extract-package-info'." (project-am-extract-package-info dir))) ;; for simple per project include path extension -(cl-defmethod ede-system-include-path ((this project-am-makefile)) +(cl-defmethod ede-system-include-path ((_this project-am-makefile)) "Return `project-am-localvars-include-path', usually local variable per file or in .dir-locals.el or similar." (bound-and-true-p project-am-localvars-include-path)) -(cl-defmethod ede-system-include-path ((this project-am-target)) +(cl-defmethod ede-system-include-path ((_this project-am-target)) "Return `project-am-localvars-include-path', usually local variable per file or in .dir-locals.el or similar." (bound-and-true-p project-am-localvars-include-path)) diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index 31576d29bc6..6bd04b2e346 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -1,4 +1,4 @@ -;;; semantic/scope.el --- Analyzer Scope Calculations +;;; semantic/scope.el --- Analyzer Scope Calculations -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -115,7 +115,7 @@ Saves scoping information between runs of the analyzer.") ) (cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache) - new-tags) + _new-tags) "Synchronize a CACHE with some NEW-TAGS." (semantic-reset cache)) @@ -262,7 +262,7 @@ are from nesting data types." (semantic-go-to-tag pparent) (setq stack (semantic-find-tag-by-overlay (point))) ;; Step one, find the merged version of stack in the typecache. - (let* ((stacknames (reverse (mapcar 'semantic-tag-name stack))) + (let* ((stacknames (reverse (mapcar #'semantic-tag-name stack))) (tc nil) ) ;; @todo - can we use the typecache ability to @@ -317,7 +317,7 @@ are from nesting data types." ;; returnlist is empty. (while snlist (setq fullsearchname - (append (mapcar 'semantic-tag-name returnlist) + (append (mapcar #'semantic-tag-name returnlist) (list (car snlist)))) ;; Next one (setq ptag (semanticdb-typecache-find fullsearchname)) @@ -325,8 +325,8 @@ are from nesting data types." (when (or (not ptag) (not (semantic-tag-of-class-p ptag 'type))) (let ((rawscope - (apply 'append - (mapcar 'semantic-tag-type-members + (apply #'append + (mapcar #'semantic-tag-type-members (cons (car returnlist) scopetypes) ))) ) @@ -541,7 +541,7 @@ tag is not something you can complete from within TYPE." (setq leftover (cons S leftover))))) (nreverse leftover))) -(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection) +(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit _protection) "Return all parts of TYPE, a tag representing a TYPE declaration. SCOPE is the scope object. NOINHERIT turns off searching of inherited tags. From 7020fce353b3e836c03703683e447a9ddf209b6a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 9 Feb 2021 20:12:36 +0200 Subject: [PATCH 083/297] New options read-char-by-name-sort and read-char-by-name-group (bug#46240) * lisp/international/mule-cmds.el (mule--ucs-names-sort-by-code) (mule--ucs-names-group): New functions. (read-char-by-name-sort, read-char-by-name-group): New defcustoms. (read-char-by-name): Use them. --- etc/NEWS | 8 ++++ lisp/international/mule-cmds.el | 66 ++++++++++++++++++++++++++++++++- 2 files changed, 72 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 5325e87ccf3..bd209de18e6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -871,6 +871,14 @@ iso-transl RET', it supports the same key sequences as 'C-x 8', so e.g. like 'C-x 8 [' inserts a left single quotation mark, 'C-x \ [' does the same. +--- +*** New user options 'read-char-by-name-sort' and 'read-char-by-name-group'. +'read-char-by-name-sort' defines the sorting order of characters for +completion of 'C-x 8 RET TAB' and can be customized to sort them +by codepoints instead of character names by default. The 't' value of +'read-char-by-name-group' groups the characters for completion of +'C-x 8 RET TAB' by Unicode blocks. + --- *** Improved language transliteration in Malayalam input methods. Added a new Mozhi scheme. The inapplicable ITRANS scheme is now diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 5dc3de4422b..5f66328e944 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3077,12 +3077,48 @@ on encoding." (puthash "BELL (BEL)" ?\a names) (setq ucs-names names)))) +(defun mule--ucs-names-sort-by-code (names) + (let* ((codes-and-names + (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)) + (sorted (sort codes-and-names (lambda (a b) (< (car a) (car b)))))) + (mapcar #'cdr sorted))) + (defun mule--ucs-names-affixation (names) (mapcar (lambda (name) (let ((char (gethash name ucs-names))) (list name (concat (if char (format "%c" char) " ") "\t") ""))) names)) +(defun mule--ucs-names-group (names) + (let* ((codes-and-names + (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)) + (grouped + (seq-group-by + (lambda (code-name) + (let ((script (aref char-script-table (car code-name)))) + (if script (symbol-name script) "ungrouped"))) + codes-and-names)) + names-with-header header) + (dolist (group (sort grouped (lambda (a b) (string< (car a) (car b))))) + (setq header t) + (dolist (code-name (cdr group)) + (push (list + (cdr code-name) + (concat + (if header + (progn + (setq header nil) + (concat "\n" (propertize + (format "* %s\n" (car group)) + 'face 'header-line))) + "") + ;; prefix + (if (car code-name) (format "%c" (car code-name)) " ") "\t") + ;; suffix + "") + names-with-header))) + (nreverse names-with-header))) + (defun char-from-name (string &optional ignore-case) "Return a character as a number from its Unicode name STRING. If optional IGNORE-CASE is non-nil, ignore case in STRING. @@ -3104,6 +3140,23 @@ Return nil if STRING does not name a character." ignore-case)) code))))))) +(defcustom read-char-by-name-sort nil + "How to sort characters for `read-char-by-name' completion. +Defines the sorting order either by character names or their codepoints." + :type '(choice + (const :tag "Sort by character names" nil) + (const :tag "Sort by character codepoints" code)) + :group 'mule + :version "28.1") + +(defcustom read-char-by-name-group nil + "How to group characters for `read-char-by-name' completion. +When t, split characters to sections of Unicode blocks +sorted alphabetically." + :type 'boolean + :group 'mule + :version "28.1") + (defun read-char-by-name (prompt) "Read a character by its Unicode name or hex number string. Display PROMPT and read a string that represents a character by its @@ -3117,6 +3170,9 @@ preceded by an asterisk `*' and use completion, it will show all the characters whose names include that substring, not necessarily at the beginning of the name. +The options `read-char-by-name-sort' and `read-char-by-name-group' +define the sorting order of completion characters and how to group them. + Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal number like \"2A10\", or a number in hash notation (e.g., \"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for @@ -3130,8 +3186,14 @@ as names, not numbers." prompt (lambda (string pred action) (if (eq action 'metadata) - '(metadata - (affixation-function . mule--ucs-names-affixation) + `(metadata + (display-sort-function + . ,(when (eq read-char-by-name-sort 'code) + 'mule--ucs-names-sort-by-code)) + (affixation-function + . ,(if read-char-by-name-group + 'mule--ucs-names-group + 'mule--ucs-names-affixation)) (category . unicode-name)) (complete-with-action action (ucs-names) string pred))))) (char From 80c9871428aca6927b3723d1808497e8cb78e17b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Feb 2021 13:27:08 -0500 Subject: [PATCH 084/297] Use lexical-binding in a few more scattered files * lisp/registry.el: Use lexical-binding. (registry-reindex): Remove unused var `values`. * lisp/cedet/pulse.el: Use lexical-binding. * lisp/cedet/semantic/idle.el: Use lexical-binding. (semantic-idle-core-handler): Remove unused var `safe`. (ede-auto-add-method): Declare var. (define-semantic-idle-service): Use `declare`. Remove unused var `setup`. (pulse-flag): Declare var. * lisp/net/ldap.el: Use lexical-binding. (ldap-search-internal): Remove unused var `proc`. * lisp/net/mairix.el: Use lexical-binding. Remove redundant `:group` args. (mairix-widget-create-query): Remove unnused var `allwidgets`. --- lisp/cedet/pulse.el | 4 +- lisp/cedet/semantic/idle.el | 30 ++++---- lisp/net/ldap.el | 10 +-- lisp/net/mairix.el | 145 ++++++++++++++++-------------------- lisp/registry.el | 33 ++++---- 5 files changed, 103 insertions(+), 119 deletions(-) diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index aef4fc89057..3257feb1fed 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -1,6 +1,6 @@ -;;; pulse.el --- Pulsing Overlays +;;; pulse.el --- Pulsing Overlays -*- lexical-binding: t; -*- -;;; Copyright (C) 2007-2021 Free Software Foundation, Inc. +;; Copyright (C) 2007-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Version: 1.0 diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 9f1bcfa6916..29cc8187e19 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -1,4 +1,4 @@ -;;; idle.el --- Schedule parsing tasks in idle time +;;; idle.el --- Schedule parsing tasks in idle time -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2006, 2008-2021 Free Software Foundation, Inc. @@ -222,18 +222,18 @@ And also manages services that depend on tag values." (and (buffer-file-name b) b)) (buffer-list))))) - safe ;; This safe is not used, but could be. + ;; safe ;; This safe is not used, but could be. others mode) (when (semantic-idle-scheduler-enabled-p) (save-excursion ;; First, reparse the current buffer. - (setq mode major-mode - safe (semantic-safe "Idle Parse Error: %S" - ;(error "Goofy error 1") - (semantic-idle-scheduler-refresh-tags) - ) - ) + (setq mode major-mode) + ;; (setq safe + (semantic-safe "Idle Parse Error: %S" + ;(error "Goofy error 1") + (semantic-idle-scheduler-refresh-tags)) + ;; Now loop over other buffers with same major mode, trying to ;; update them as well. Stop on keypress. (dolist (b buffers) @@ -430,6 +430,8 @@ datasets." (message "Long Work Idle Timer...%s" exit-type))) ) +(defvar ede-auto-add-method) + (defun semantic-idle-scheduler-work-parse-neighboring-files () "Parse all the files in similar directories to buffers being edited." ;; Let's tell EDE to ignore all the files we're about to load @@ -564,11 +566,12 @@ DOC will be a documentation string describing FORMS. FORMS will be called during idle time after the current buffer's semantic tag information has been updated. This routine creates the following functions and variables:" + (declare (indent 1) (debug (&define name stringp def-body))) (let ((global (intern (concat "global-" (symbol-name name) "-mode"))) (mode (intern (concat (symbol-name name) "-mode"))) (hook (intern (concat (symbol-name name) "-mode-hook"))) (map (intern (concat (symbol-name name) "-mode-map"))) - (setup (intern (concat (symbol-name name) "-mode-setup"))) + ;; (setup (intern (concat (symbol-name name) "-mode-setup"))) (func (intern (concat (symbol-name name) "-idle-function")))) `(progn @@ -618,11 +621,6 @@ turned on in every Semantic-supported buffer.") ,(concat "Perform idle activity for the minor mode `" (symbol-name mode) "'.") ,@forms)))) -(put 'define-semantic-idle-service 'lisp-indent-function 1) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec define-semantic-idle-service - (&define name stringp def-body)))) ;;; SUMMARY MODE ;; @@ -821,6 +819,8 @@ turned on in every Semantic-supported buffer." (make-obsolete-variable 'semantic-idle-symbol-highlight-face "customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set) +(defvar pulse-flag) + (defun semantic-idle-symbol-maybe-highlight (tag) "Perhaps add highlighting to the symbol represented by TAG. TAG was found as the symbol under point. If it happens to be @@ -1231,7 +1231,7 @@ shortened at the beginning." ) (defun semantic-idle-breadcrumbs--format-linear - (tag-list &optional max-length) + (tag-list &optional _max-length) "Format TAG-LIST as a linear list, starting with the outermost tag. MAX-LENGTH is not used." (require 'semantic/analyze/fcn) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 0476835ebd9..7997bf3c90b 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -1,4 +1,4 @@ -;;; ldap.el --- client interface to LDAP for Emacs +;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -418,12 +418,12 @@ RFC2798 Section 9.1.1") (encode-coding-string str ldap-coding-system)) (defun ldap-decode-address (str) - (mapconcat 'ldap-decode-string + (mapconcat #'ldap-decode-string (split-string str "\\$") "\n")) (defun ldap-encode-address (str) - (mapconcat 'ldap-encode-string + (mapconcat #'ldap-encode-string (split-string str "\n") "$")) @@ -601,7 +601,7 @@ an alist of attribute/value pairs." (sizelimit (plist-get search-plist 'sizelimit)) (withdn (plist-get search-plist 'withdn)) (numres 0) - arglist dn name value record result proc) + arglist dn name value record result) (if (or (null filter) (equal "" filter)) (error "No search filter")) @@ -671,7 +671,7 @@ an alist of attribute/value pairs." " bind distinguished name (binddn)")) (error "Failed ldapsearch invocation: %s \"%s\"" ldap-ldapsearch-prog - (mapconcat 'identity proc-args "\" \"")))))) + (mapconcat #'identity proc-args "\" \"")))))) (apply #'call-process ldap-ldapsearch-prog ;; Ignore stderr, which can corrupt results nil (list buf nil) nil diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index 08edb44275c..024d118f2de 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -1,4 +1,4 @@ -;;; mairix.el --- Mairix interface for Emacs +;;; mairix.el --- Mairix interface for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -83,55 +83,46 @@ (defcustom mairix-file-path "~/" "Path where output files produced by Mairix should be stored." - :type 'directory - :group 'mairix) + :type 'directory) (defcustom mairix-search-file "mairixsearch.mbox" "Name of the default file for storing the searches. Note that this will be prefixed by `mairix-file-path'." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-command "mairix" "Command for calling mairix. You can add further options here if you want to, but better use `mairix-update-options' instead." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-output-buffer "*mairix output*" "Name of the buffer for the output of the mairix binary." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-customize-query-buffer "*mairix query*" "Name of the buffer for customizing a search query." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-saved-searches-buffer "*mairix searches*" "Name of the buffer for displaying saved searches." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-update-options '("-F" "-Q") "Options when calling mairix for updating the database. The default is \"-F\" and \"-Q\" for making updates faster. You should call mairix without these options from time to time (e.g. via cron job)." - :type '(repeat string) - :group 'mairix) + :type '(repeat string)) (defcustom mairix-search-options '("-Q") "Options when calling mairix for searching. The default is \"-Q\" for making searching faster." - :type '(repeat string) - :group 'mairix) + :type '(repeat string)) (defcustom mairix-synchronous-update nil "Defines if Emacs should wait for the mairix database update." - :type 'boolean - :group 'mairix) + :type 'boolean) (defcustom mairix-saved-searches nil "Saved mairix searches. @@ -144,8 +135,7 @@ threads (nil or t). Note that the file will be prefixed by (choice :tag "File" (const :tag "default") file) - (boolean :tag "Threads"))) - :group 'mairix) + (boolean :tag "Threads")))) (defcustom mairix-mail-program 'rmail "Mail program used to display search results. @@ -153,8 +143,7 @@ Currently RMail, Gnus (mbox), and VM are supported. If you use Gnus with maildir, use nnmairix.el instead." :type '(choice (const :tag "RMail" rmail) (const :tag "Gnus mbox" gnus) - (const :tag "VM" vm)) - :group 'mairix) + (const :tag "VM" vm))) (defcustom mairix-display-functions '((rmail mairix-rmail-display) @@ -166,8 +155,7 @@ This is an alist where each entry consists of a symbol from displaying the search results. The function will be called with the mailbox file produced by mairix as the single argument." :type '(repeat (list (symbol :tag "Mail program") - (function))) - :group 'mairix) + (function)))) (defcustom mairix-get-mail-header-functions '((rmail mairix-rmail-fetch-field) @@ -184,15 +172,13 @@ won't work." :type '(repeat (list (symbol :tag "Mail program") (choice :tag "Header function" (const :tag "none") - function))) - :group 'mairix) + function)))) (defcustom mairix-widget-select-window-function (lambda () (select-window (get-largest-window))) "Function for selecting the window for customizing the mairix query. The default chooses the largest window in the current frame." - :type 'function - :group 'mairix) + :type 'function) ;; Other variables @@ -466,18 +452,18 @@ MVALUES may contain values from current article." ;; generate Buttons (widget-create 'push-button :notify - (lambda (&rest ignore) + (lambda (&rest _) (mairix-widget-send-query mairix-widgets)) "Send Query") (widget-insert " ") (widget-create 'push-button :notify - (lambda (&rest ignore) + (lambda (&rest _) (mairix-widget-save-search mairix-widgets)) "Save search") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _) (kill-buffer mairix-customize-query-buffer)) "Cancel") (use-local-map widget-keymap) @@ -502,7 +488,7 @@ Mairix will be called asynchronously unless (cdr commandsplit) mairix-update-options)) (setq args (append args mairix-update-options))) - (apply 'call-process args)) + (apply #'call-process args)) (progn (message "Updating mairix database...") (setq args (append (list "mairixupdate" (get-buffer-create mairix-output-buffer) @@ -511,8 +497,8 @@ Mairix will be called asynchronously unless (setq args (append args (cdr commandsplit) mairix-update-options)) (setq args (append args mairix-update-options))) (set-process-sentinel - (apply 'start-process args) - 'mairix-sentinel-mairix-update-finished))))) + (apply #'start-process args) + #'mairix-sentinel-mairix-update-finished))))) ;;;; Helper functions @@ -557,7 +543,7 @@ whole threads. Function returns t if messages were found." mairix-file-path)) file)) (setq rval - (apply 'call-process + (apply #'call-process (append args (list "-o" file) query))) (if (zerop rval) (with-current-buffer mairix-output-buffer @@ -582,7 +568,7 @@ whole threads. Function returns t if messages were found." (setq header (replace-match "," t t header))) header)) -(defun mairix-sentinel-mairix-update-finished (proc status) +(defun mairix-sentinel-mairix-update-finished (_proc status) "Sentinel for mairix update process PROC with STATUS." (if (equal status "finished\n") (message "Updating mairix database... done") @@ -642,51 +628,50 @@ See %s for details" mairix-output-buffer))) (when (not (zerop (length flag))) (push (concat "F:" flag) query))) ;; return query string - (mapconcat 'identity query " "))) + (mapconcat #'identity query " "))) (defun mairix-widget-create-query (&optional values) "Create widgets for creating mairix queries. Fill in VALUES if based on an article." - (let (allwidgets) - (when (get-buffer mairix-customize-query-buffer) - (kill-buffer mairix-customize-query-buffer)) - (switch-to-buffer mairix-customize-query-buffer) - (kill-all-local-variables) - (erase-buffer) - (widget-insert - "Specify your query for Mairix using check boxes for activating fields.\n\n") - (widget-insert - (concat "Use ~word to match messages " - (propertize "not" 'face 'italic) - " containing the word)\n" - " substring= to match words containing the substring\n" - " substring=N to match words containing the substring, allowing\n" - " up to N errors(missing/extra/different letters)\n" - " ^substring= to match the substring at the beginning of a word.\n")) - (widget-insert - (format-message - "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n")) - (setq mairix-widgets (mairix-widget-build-editable-fields values)) - (when (member 'flags mairix-widget-other) - (widget-insert "\nFlags:\n Seen: ") - (mairix-widget-add "seen" - 'menu-choice - :value "ignore" - '(item "yes") '(item "no") '(item "ignore")) - (widget-insert " Replied: ") - (mairix-widget-add "replied" - 'menu-choice - :value "ignore" - '(item "yes") '(item "no") '(item "ignore")) - (widget-insert " Ticked: ") - (mairix-widget-add "flagged" - 'menu-choice - :value "ignore" - '(item "yes") '(item "no") '(item "ignore"))) - (when (member 'threads mairix-widget-other) - (widget-insert "\n") - (mairix-widget-add "Threads" 'checkbox nil)) - (widget-insert " Show full threads\n\n"))) + (when (get-buffer mairix-customize-query-buffer) + (kill-buffer mairix-customize-query-buffer)) + (switch-to-buffer mairix-customize-query-buffer) + (kill-all-local-variables) + (erase-buffer) + (widget-insert + "Specify your query for Mairix using check boxes for activating fields.\n\n") + (widget-insert + (concat "Use ~word to match messages " + (propertize "not" 'face 'italic) + " containing the word)\n" + " substring= to match words containing the substring\n" + " substring=N to match words containing the substring, allowing\n" + " up to N errors(missing/extra/different letters)\n" + " ^substring= to match the substring at the beginning of a word.\n")) + (widget-insert + (format-message + "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n")) + (setq mairix-widgets (mairix-widget-build-editable-fields values)) + (when (member 'flags mairix-widget-other) + (widget-insert "\nFlags:\n Seen: ") + (mairix-widget-add "seen" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore")) + (widget-insert " Replied: ") + (mairix-widget-add "replied" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore")) + (widget-insert " Ticked: ") + (mairix-widget-add "flagged" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore"))) + (when (member 'threads mairix-widget-other) + (widget-insert "\n") + (mairix-widget-add "Threads" 'checkbox nil)) + (widget-insert " Show full threads\n\n")) (defun mairix-widget-build-editable-fields (values) "Build editable field widgets in `nnmairix-widget-fields-list'. @@ -703,7 +688,7 @@ VALUES may contain values for editable fields from current article." (concat "c" field) (widget-create 'checkbox :tag field - :notify (lambda (widget &rest ignore) + :notify (lambda (widget &rest _ignore) (mairix-widget-toggle-activate widget)) nil))) (list @@ -727,7 +712,7 @@ VALUES may contain values for editable fields from current article." "Add a widget NAME with optional ARGS." (push (list name - (apply 'widget-create args)) + (apply #'widget-create args)) mairix-widgets)) (defun mairix-widget-toggle-activate (widget) diff --git a/lisp/registry.el b/lisp/registry.el index a5c30f20efc..258f7fc9046 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -1,4 +1,4 @@ -;;; registry.el --- Track and remember data items by various fields +;;; registry.el --- Track and remember data items by various fields -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2021 Free Software Foundation, Inc. @@ -128,7 +128,7 @@ :type hash-table :documentation "The data hash table."))) -(cl-defmethod initialize-instance :before ((this registry-db) slots) +(cl-defmethod initialize-instance :before ((_this registry-db) slots) "Check whether a registry object needs to be upgraded." ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the ;; :max-soft slot to disappear, and the :max-hard slot to be renamed @@ -212,7 +212,7 @@ When SET is not nil, set it for VAL (use t for an empty list)." (:regex (string-match (car vals) (mapconcat - 'prin1-to-string + #'prin1-to-string (cdr-safe (assoc key entry)) "\0")))) vals (cdr-safe vals))) @@ -247,7 +247,7 @@ Updates the secondary ('tracked') indices as well. With assert non-nil, errors out if the key does not exist already." (let* ((data (oref db data)) (keys (or keys - (apply 'registry-search db spec))) + (apply #'registry-search db spec))) (tracked (oref db tracked))) (dolist (key keys) @@ -308,19 +308,18 @@ Errors out if the key exists already." (let ((count 0) (expected (* (length (oref db tracked)) (registry-size db)))) (dolist (tr (oref db tracked)) - (let (values) - (maphash - (lambda (key v) - (cl-incf count) - (when (and (< 0 expected) - (= 0 (mod count 1000))) - (message "reindexing: %d of %d (%.2f%%)" - count expected (/ (* 100.0 count) expected))) - (dolist (val (cdr-safe (assq tr v))) - (let ((value-keys (registry-lookup-secondary-value db tr val))) - (push key value-keys) - (registry-lookup-secondary-value db tr val value-keys)))) - (oref db data)))))) + (maphash + (lambda (key v) + (cl-incf count) + (when (and (< 0 expected) + (= 0 (mod count 1000))) + (message "reindexing: %d of %d (%.2f%%)" + count expected (/ (* 100.0 count) expected))) + (dolist (val (cdr-safe (assq tr v))) + (let ((value-keys (registry-lookup-secondary-value db tr val))) + (push key value-keys) + (registry-lookup-secondary-value db tr val value-keys)))) + (oref db data))))) (cl-defmethod registry-prune ((db registry-db) &optional sortfunc) "Prune the registry-db object DB. From 552d2b9083c2dac210fd8f565b2d46897ae9d4ed Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 9 Feb 2021 20:29:54 +0200 Subject: [PATCH 085/297] * lisp/net/dictionary.el: Dictionary improvements (bug#45262) * lisp/net/dictionary.el (dictionary-link-dictionary): New defcustom. (dictionary-mark-reference): Use dictionary-link-dictionary. (dictionary-post-buffer-hook): New defcustom. (dictionary-post-buffer): Run dictionary-post-buffer-hook. (dictionary-mode-map): Bind 'S-SPC' to scroll-down-command. (dictionary-search-default): Use possibly multi-word data at point. --- lisp/net/dictionary.el | 37 +++++++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 6 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index ccc24cbf303..6f086053b6a 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -160,6 +160,18 @@ by the choice value: :type 'boolean :version "28.1") +(defcustom dictionary-link-dictionary + "*" + "The dictionary which is used in links. +* means to create links that search all dictionaries, +nil means to create links that search only in the same dictionary +where the current word was found." + :group 'dictionary + :type '(choice (const :tag "Link to all dictionaries" "*") + (const :tag "Link only to the same dictionary" nil) + (string :tag "User choice")) + :version "28.1") + (defcustom dictionary-mode-hook nil "Hook run in dictionary mode buffers." @@ -167,6 +179,13 @@ by the choice value: :type 'hook :version "28.1") +(defcustom dictionary-post-buffer-hook + nil + "Hook run at the end of every update of the dictionary buffer." + :group 'dictionary + :type 'hook + :version "28.1") + (defcustom dictionary-use-http-proxy nil "Connects via a HTTP proxy using the CONNECT command when not nil." @@ -323,8 +342,9 @@ is utf-8" (define-key map "l" 'dictionary-previous) (define-key map "n" 'forward-button) (define-key map "p" 'backward-button) - (define-key map " " 'scroll-up) - (define-key map (read-kbd-macro "M-SPC") 'scroll-down) + (define-key map " " 'scroll-up-command) + (define-key map [?\S-\ ] 'scroll-down-command) + (define-key map (read-kbd-macro "M-SPC") 'scroll-down-command) map) "Keymap for the dictionary mode.") @@ -772,7 +792,8 @@ of matching words." (goto-char dictionary-marker) (set-buffer-modified-p nil) - (setq buffer-read-only t)) + (setq buffer-read-only t) + (run-hooks 'dictionary-post-buffer-hook)) (defun dictionary-display-search-result (reply) "Start displaying the result in REPLY." @@ -842,6 +863,8 @@ The word is taken from the buffer, the DICTIONARY is given as argument." (setq word (replace-match " " t t word))) (while (string-match "[*\"]" word) (setq word (replace-match "" t t word))) + (when dictionary-link-dictionary + (setq dictionary dictionary-link-dictionary)) (unless (equal word displayed-word) (make-button start end :type 'dictionary-link @@ -1117,9 +1140,11 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." ;; - if region is active returns its contents ;; - otherwise return the word near the point (defun dictionary-search-default () - (if (use-region-p) - (buffer-substring-no-properties (region-beginning) (region-end)) - (current-word t))) + (cond + ((use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end))) + ((car (get-char-property (point) 'data))) + (t (current-word t)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User callable commands From 817a49748f0cd7f746ce1895d7c31c086289a91e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 9 Feb 2021 20:57:29 +0200 Subject: [PATCH 086/297] Fix syntax category of some characters * lisp/international/characters.el (modify-syntax-entry): Fix syntax of numerical subscripts and superscripts. (Bug#46240) --- lisp/international/characters.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 9bce419b489..c643f66cbb0 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -265,7 +265,7 @@ with L, LRE, or LRO Unicode bidi character type.") (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E) (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E) (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E) -(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E) +(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x2975) (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339) (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A) (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A) From e4328d4b3eea1849b5f081a6d3d2a27f633362d6 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 9 Feb 2021 18:59:24 +0000 Subject: [PATCH 087/297] Tiny simplification to read-char-by-name * lisp/international/mule-cmds.el (mule--ucs-names-sort-by-code): Sort with car-less-than-car instead of slower lambda. (mule--ucs-names-affixation): Just stick character into a list to avoid trip through format and char-to-string. (read-char-by-name): Quote function symbols as such. --- lisp/international/mule-cmds.el | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 5f66328e944..e4bdf50f526 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3078,15 +3078,14 @@ on encoding." (setq ucs-names names)))) (defun mule--ucs-names-sort-by-code (names) - (let* ((codes-and-names - (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)) - (sorted (sort codes-and-names (lambda (a b) (< (car a) (car b)))))) - (mapcar #'cdr sorted))) + (let ((codes-and-names + (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names))) + (mapcar #'cdr (sort codes-and-names #'car-less-than-car)))) (defun mule--ucs-names-affixation (names) (mapcar (lambda (name) (let ((char (gethash name ucs-names))) - (list name (concat (if char (format "%c" char) " ") "\t") ""))) + (list name (concat (if char (list char) " ") "\t") ""))) names)) (defun mule--ucs-names-group (names) @@ -3189,11 +3188,11 @@ as names, not numbers." `(metadata (display-sort-function . ,(when (eq read-char-by-name-sort 'code) - 'mule--ucs-names-sort-by-code)) + #'mule--ucs-names-sort-by-code)) (affixation-function . ,(if read-char-by-name-group - 'mule--ucs-names-group - 'mule--ucs-names-affixation)) + #'mule--ucs-names-group + #'mule--ucs-names-affixation)) (category . unicode-name)) (complete-with-action action (ucs-names) string pred))))) (char From bff9bd0d3acff0fa0a50e21bdeca024e71fa518b Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 9 Feb 2021 19:04:58 +0000 Subject: [PATCH 088/297] ; Fix warning in last change to semantic/idle.el. --- lisp/cedet/semantic/idle.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 29cc8187e19..5af4607abb8 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -898,7 +898,7 @@ Call `semantic-symref-hits-in-region' to identify local references." (when (semantic-tag-p target) (require 'semantic/symref/filter) (semantic-symref-hits-in-region - target (lambda (start end prefix) + target (lambda (start end _prefix) (when (/= start (car Hbounds)) (pulse-momentary-highlight-region start end semantic-idle-symbol-highlight-face)) From ff16c897eadab9bebc58bd0ca0fb5c8e1c237a15 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Tue, 9 Feb 2021 06:49:05 +0200 Subject: [PATCH 089/297] Refine use of vc-dir faces; apply to all backends * lisp/vc/vc-dir.el (vc-default-dir-printer): Add check for the "ignored" status and make 'vc-dir-status-edited' the default face. Also extend condition for more states that qualify as "warnings". (vc-dir-ignored, vc-dir-status-ignored): Rename face for consistency. * lisp/vc/vc-git.el (vc-git-dir-printer): Use the 'vc-dir-status-edited' as the default for the Git backend. And reference the renamed face. Also stop treating the empty stash differently from other header values. * lisp/vc/vc-bzr.el (vc-bzr-dir-extra-headers): Implement new faces. * lisp/vc/vc-cvs.el (vc-cvs-dir-extra-headers): Same. * lisp/vc/vc-hg.el (vc-hg-dir-extra-headers): Same. * lisp/vc/vc-svn.el (vc-svn-dir-extra-headers): Same. This follows from the discussion in bug#46358. --- lisp/vc/vc-bzr.el | 24 ++++++++++++------------ lisp/vc/vc-cvs.el | 18 +++++++++--------- lisp/vc/vc-dir.el | 12 +++++++----- lisp/vc/vc-git.el | 5 +++-- lisp/vc/vc-hg.el | 4 ++-- lisp/vc/vc-svn.el | 4 ++-- 6 files changed, 35 insertions(+), 32 deletions(-) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index c495afb6ec5..d1385ea7784 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1076,49 +1076,49 @@ stream. Standard error output is discarded." (when (string-match ".+checkout of branch: \\(.+\\)$" str) (match-string 1 str))))) (concat - (propertize "Parent branch : " 'face 'font-lock-type-face) + (propertize "Parent branch : " 'face 'vc-dir-header) (propertize (if (string-match "parent branch: \\(.+\\)$" str) (match-string 1 str) "None") - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) "\n" (when light-checkout (concat - (propertize "Light checkout root: " 'face 'font-lock-type-face) - (propertize light-checkout 'face 'font-lock-variable-name-face) + (propertize "Light checkout root: " 'face 'vc-dir-header) + (propertize light-checkout 'face 'vc-dir-header-value) "\n")) (when light-checkout-branch (concat - (propertize "Checkout of branch : " 'face 'font-lock-type-face) - (propertize light-checkout-branch 'face 'font-lock-variable-name-face) + (propertize "Checkout of branch : " 'face 'vc-dir-header) + (propertize light-checkout-branch 'face 'vc-dir-header-value) "\n")) (when pending-merge (concat - (propertize "Warning : " 'face 'font-lock-warning-face + (propertize "Warning : " 'face 'vc-dir-status-warning 'help-echo pending-merge-help-echo) (propertize "Pending merges, commit recommended before any other action" 'help-echo pending-merge-help-echo - 'face 'font-lock-warning-face) + 'face 'vc-dir-status-warning) "\n")) (if shelve (concat - (propertize "Shelves :\n" 'face 'font-lock-type-face + (propertize "Shelves :\n" 'face 'vc-dir-header 'help-echo shelve-help-echo) (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'help-echo "mouse-3: Show shelve menu\nA: Apply and keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k: Delete shelf" 'keymap vc-bzr-shelve-map)) shelve "\n")) (concat - (propertize "Shelves : " 'face 'font-lock-type-face + (propertize "Shelves : " 'face 'vc-dir-header 'help-echo shelve-help-echo) (propertize "No shelved changes" 'help-echo shelve-help-echo - 'face 'font-lock-variable-name-face)))))) + 'face 'vc-dir-header-value)))))) ;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher. (declare-function vc-resynch-buffer "vc-dispatcher" diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index a595cc9778b..0adb5328bc2 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -1047,29 +1047,29 @@ Query all files in DIR if files is nil." (file-error nil)))) (concat (cond (repo - (concat (propertize "Repository : " 'face 'font-lock-type-face) - (propertize repo 'face 'font-lock-variable-name-face))) + (concat (propertize "Repository : " 'face 'vc-dir-header) + (propertize repo 'face 'vc-dir-header-value))) (t "")) (cond (module - (concat (propertize "Module : " 'face 'font-lock-type-face) - (propertize module 'face 'font-lock-variable-name-face))) + (concat (propertize "Module : " 'face 'vc-dir-header) + (propertize module 'face 'vc-dir-header-value))) (t "")) (if (file-readable-p "CVS/Tag") (let ((tag (vc-cvs-file-to-string "CVS/Tag"))) (cond ((string-match "\\`T" tag) - (concat (propertize "Tag : " 'face 'font-lock-type-face) + (concat (propertize "Tag : " 'face 'vc-dir-header) (propertize (substring tag 1) - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) ((string-match "\\`D" tag) - (concat (propertize "Date : " 'face 'font-lock-type-face) + (concat (propertize "Date : " 'face 'vc-dir-header) (propertize (substring tag 1) - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) (t "")))) ;; In CVS, branch is a per-file property, not a per-directory property. ;; We can't really do this here without making dangerous assumptions. - ;;(propertize "Branch: " 'face 'font-lock-type-face) + ;;(propertize "Branch: " 'face 'vc-dir-header) ;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n" ;; 'face 'font-lock-warning-face) ))) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 14c81578b79..a416474e16d 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -86,7 +86,7 @@ See `run-hooks'." "Face for up-to-date status in VC-dir buffers." :group 'vc) -(defface vc-dir-ignored '((t :inherit shadow)) +(defface vc-dir-status-ignored '((t :inherit shadow)) "Face for ignored or empty values in VC-dir buffers." :group 'vc) @@ -1454,10 +1454,12 @@ These are the commands available for use in the file status buffer: " " (propertize (format "%-20s" state) - 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) - ((memq state '(missing conflict)) 'vc-dir-status-warning) - ((eq state 'edited) 'font-lock-constant-face) - (t 'vc-dir-header-value)) + 'face (cond + ((eq state 'up-to-date) 'vc-dir-status-up-to-date) + ((memq state '(missing conflict needs-update unlocked-changes)) + 'vc-dir-status-warning) + ((eq state 'ignored) 'vc-dir-status-ignored) + (t 'vc-dir-status-edited)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) " " diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e7306386fea..25ae26d746a 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -479,7 +479,8 @@ or an empty string if none." (propertize (format "%-12s" state) 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) - ((eq state '(missing conflict)) 'vc-dir-status-warning) + ((memq state '(missing conflict)) 'vc-dir-status-warning) + ((eq state 'ignored) 'vc-dir-status-ignored) (t 'vc-dir-status-edited)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) @@ -835,7 +836,7 @@ or an empty string if none." (propertize "Nothing stashed" 'help-echo vc-git-stash-shared-help 'keymap vc-git-stash-shared-map - 'face 'vc-dir-ignored)))))) + 'face 'vc-dir-header-value)))))) (defun vc-git-branches () "Return the existing branches, as a list of strings. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 1d163a64ab2..adb0fce8759 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1403,8 +1403,8 @@ This runs the command \"hg summary\"." (cons (capitalize (match-string 1)) (match-string 2)) (cons "" (buffer-substring (point) (line-end-position)))))) (concat - (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face) - (propertize (cdr entry) 'face 'font-lock-variable-name-face))) + (propertize (format "%-11s: " (car entry)) 'face 'vc-dir-header) + (propertize (cdr entry) 'face 'vc-dir-header-value))) result) (forward-line)) (nreverse result)) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index da5471107d2..22becc91cd1 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -239,8 +239,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (concat (cond (repo (concat - (propertize "Repository : " 'face 'font-lock-type-face) - (propertize repo 'face 'font-lock-variable-name-face))) + (propertize "Repository : " 'face 'vc-dir-header) + (propertize repo 'face 'vc-dir-header-value))) (t ""))))) (defun vc-svn-working-revision (file) From a0451be18b2581f5288e1123ee7bbd2aabccbe52 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 01:23:41 +0100 Subject: [PATCH 090/297] Use lexical-binding in almost all of play/*.el * lisp/play/5x5.el: Use lexical-binding. (5x5-draw-grid-end, 5x5-draw-grid, 5x5-solver) (5x5-solve-suggest): Silence byte-compiler. * lisp/play/cookie1.el: Use lexical-binding. (cookie-shuffle-vector, cookie-apropos): Silence byte-compiler. * lisp/play/zone.el: Use lexical-binding. (zone): Convert lambda to proper lexical closure. (zone-replace-char, zone-fill-out-screen): Silence byte-compiler. * lisp/play/blackbox.el: * lisp/play/doctor.el: * lisp/play/gametree.el: * lisp/play/hanoi.el: Use lexical-binding. * test/lisp/play/cookie1-resources/cookies: * test/lisp/play/cookie1-tests.el: New files. --- lisp/play/5x5.el | 42 ++++++++++++++---------- lisp/play/blackbox.el | 2 +- lisp/play/cookie1.el | 14 ++++---- lisp/play/doctor.el | 2 +- lisp/play/gametree.el | 2 +- lisp/play/hanoi.el | 2 +- lisp/play/zone.el | 21 +++++++----- test/lisp/play/cookie1-resources/cookies | 8 +++++ test/lisp/play/cookie1-tests.el | 40 ++++++++++++++++++++++ 9 files changed, 96 insertions(+), 37 deletions(-) create mode 100644 test/lisp/play/cookie1-resources/cookies create mode 100644 test/lisp/play/cookie1-tests.el diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 05e61dfe401..891a5f6cbaa 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -1,4 +1,4 @@ -;;; 5x5.el --- simple little puzzle game +;;; 5x5.el --- simple little puzzle game -*- lexical-binding: t -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -289,7 +289,7 @@ Quit current game \\[5x5-quit-game]" (defun 5x5-draw-grid-end () "Draw the top/bottom of the grid." (insert "+") - (dotimes (x 5x5-grid-size) + (dotimes (_ 5x5-grid-size) (insert "-" (make-string 5x5-x-scale ?-))) (insert "-+ ")) @@ -297,11 +297,11 @@ Quit current game \\[5x5-quit-game]" "Draw the grids GRIDS into the current buffer." (let ((inhibit-read-only t) grid-org) (erase-buffer) - (dolist (grid grids) (5x5-draw-grid-end)) + (dolist (_ grids) (5x5-draw-grid-end)) (insert "\n") (setq grid-org (point)) (dotimes (y 5x5-grid-size) - (dotimes (lines 5x5-y-scale) + (dotimes (_lines 5x5-y-scale) (dolist (grid grids) (dotimes (x 5x5-grid-size) (insert (if (zerop x) "| " " ") @@ -331,7 +331,7 @@ Quit current game \\[5x5-quit-game]" (forward-char (1+ 5x5-x-scale)))) (forward-line 5x5-y-scale)))) (setq 5x5-solver-output nil))) - (dolist (grid grids) (5x5-draw-grid-end)) + (dolist (_grid grids) (5x5-draw-grid-end)) (insert "\n") (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves)))) @@ -475,11 +475,11 @@ position." "Convert a grid matrix GRID-MATRIX in Calc format to a grid in 5x5 format. See function `5x5-grid-to-vec'." (apply - 'vector + #'vector (mapcar (lambda (x) (apply - 'vector + #'vector (mapcar (lambda (y) (/= (cadr y) 0)) (cdr x)))) @@ -503,7 +503,9 @@ position." Log a matrix VALUE of (mod B 2) forms, only B is output and Scilab matrix notation is used. VALUE is returned so that it is easy to log a value with minimal rewrite of code." - (when (buffer-live-p 5x5-log-buffer) + (when (buffer-live-p 5x5-log-buffer) + (defvar calc-matrix-brackets) + (defvar calc-vector-commas) (let* ((unpacked-value (math-map-vec (lambda (row) (math-map-vec 'cadr row)) @@ -515,7 +517,7 @@ easy to log a value with minimal rewrite of code." (insert name ?= value-to-log ?\n)))) value)) (defsubst 5x5-log-init ()) - (defsubst 5x5-log (name value) value))) + (defsubst 5x5-log (_name value) value))) (declare-function math-map-vec "calc-vec" (f a)) (declare-function math-sub "calc" (a b)) @@ -533,6 +535,10 @@ easy to log a value with minimal rewrite of code." (declare-function calcFunc-mcol "calc-vec" (mat n)) (declare-function calcFunc-vconcat "calc-vec" (a b)) (declare-function calcFunc-index "calc-vec" (n &optional start incr)) +(defvar calc-word-size) +(defvar calc-leading-zeros) +(defvar calc-number-radix) +(defvar calc-command-flags) (defun 5x5-solver (grid) "Return a list of solutions for GRID. @@ -671,16 +677,16 @@ Solutions are sorted from least to greatest Hamming weight." (5x5-log "cb" (math-mul inv-base-change targetv))); CB - (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2 + ;; (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2 (row-2 (math-make-intv 1 transferm-kernel-size grid-size-squared)); 3..25 (col-1 (math-make-intv 3 1 (- grid-size-squared transferm-kernel-size))); 1..23 - (col-2 (math-make-intv 1 (- grid-size-squared - transferm-kernel-size) - grid-size-squared)); 24..25 - (ctransferm-1-: (calcFunc-mrow ctransferm row-1)) - (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1)) + ;; (col-2 (math-make-intv 1 (- grid-size-squared + ;; transferm-kernel-size) + ;; grid-size-squared)) ; 24..25 + ;; (ctransferm-1-: (calcFunc-mrow ctransferm row-1)) + ;; (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1)) ;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0 ;; and ctransferm-2-2 = 0. @@ -696,8 +702,8 @@ Solutions are sorted from least to greatest Hamming weight." ;; ;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2)) - (ctarget-1 (calcFunc-mrow ctarget row-1)) - (ctarget-2 (calcFunc-mrow ctarget row-2)) + ;; (ctarget-1 (calcFunc-mrow ctarget row-1)) + (ctarget-2 (calcFunc-mrow ctarget row-2)) ;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1) ;; + ctransferm-1-2(2x2) *cx-2(2x1); @@ -770,7 +776,7 @@ Solutions are sorted from least to greatest Hamming weight." (message "5x5 Solution computation done.") solution-list))) -(defun 5x5-solve-suggest (&optional n) +(defun 5x5-solve-suggest (&optional _n) "Suggest to the user where to click. Argument N is ignored." diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el index e3854b55a14..61b0878b1c5 100644 --- a/lisp/play/blackbox.el +++ b/lisp/play/blackbox.el @@ -1,4 +1,4 @@ -;;; blackbox.el --- blackbox game in Emacs Lisp +;;; blackbox.el --- blackbox game in Emacs Lisp -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index 5255d81e5b1..be35daf4da8 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -1,4 +1,4 @@ -;;; cookie1.el --- retrieve random phrases from fortune cookie files +;;; cookie1.el --- retrieve random phrases from fortune cookie files -*- lexical-binding: t -*- ;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc. @@ -177,11 +177,12 @@ Argument REQUIRE-MATCH non-nil forces a matching cookie." "Randomly permute the elements of VECTOR (all permutations equally likely)." (let ((len (length vector)) j temp) - (dotimes (i len vector) + (dotimes (i len) (setq j (+ i (random (- len i))) temp (aref vector i)) (aset vector i (aref vector j)) - (aset vector j temp)))) + (aset vector j temp)) + vector)) (define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4") @@ -204,9 +205,10 @@ If called interactively, or if DISPLAY is non-nil, display a list of matches." (cookie-table-symbol (intern phrase-file cookie-cache)) (string-table (symbol-value cookie-table-symbol)) (matches nil)) - (and (dotimes (i (length string-table) matches) - (and (string-match-p regexp (aref string-table i)) - (setq matches (cons (aref string-table i) matches)))) + (dotimes (i (length string-table)) + (and (string-match-p regexp (aref string-table i)) + (setq matches (cons (aref string-table i) matches)))) + (and matches (setq matches (sort matches 'string-lessp))) (and display (if matches diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index 028f04c325b..46fd852b4c5 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -1,4 +1,4 @@ -;;; doctor.el --- psychological help for frustrated users +;;; doctor.el --- psychological help for frustrated users -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2021 Free Software ;; Foundation, Inc. diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 1c2c24ad75a..c6aef027e5f 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -1,4 +1,4 @@ -;;; gametree.el --- manage game analysis trees in Emacs +;;; gametree.el --- manage game analysis trees in Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc. diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index f6e5fcd3675..ac28fba10a4 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -1,4 +1,4 @@ -;;; hanoi.el --- towers of hanoi in Emacs +;;; hanoi.el --- towers of hanoi in Emacs -*- lexical-binding: t -*- ;; Author: Damon Anton Permezel ;; Maintainer: emacs-devel@gnu.org diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 70b6a01a017..19e4e399ff3 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -1,4 +1,4 @@ -;;; zone.el --- idle display hacks +;;; zone.el --- idle display hacks -*- lexical-binding: t -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -128,14 +128,17 @@ If the element is a function or a list of a function and a number, (let ((pgm (elt zone-programs (random (length zone-programs)))) (ct (and f (frame-parameter f 'cursor-type))) (show-trailing-whitespace nil) - (restore (list '(kill-buffer outbuf)))) + restore) (when ct - (modify-frame-parameters f '((cursor-type . (bar . 0)))) - (setq restore (cons '(modify-frame-parameters - f (list (cons 'cursor-type ct))) - restore))) + (modify-frame-parameters f '((cursor-type . (bar . 0))))) ;; Make `restore' a self-disabling one-shot thunk. - (setq restore `(lambda () ,@restore (setq restore nil))) + (setq restore + (lambda () + (when ct + (modify-frame-parameters + f (list (cons 'cursor-type ct)))) + (kill-buffer outbuf) + (setq restore nil))) (condition-case nil (progn (message "Zoning... (%s)" pgm) @@ -419,7 +422,7 @@ If the element is a function or a list of a function and a number, (defsubst zone-replace-char (count del-count char-as-string new-value) (delete-char (or del-count (- count))) (aset char-as-string 0 new-value) - (dotimes (i count) (insert char-as-string))) + (dotimes (_ count) (insert char-as-string))) (defsubst zone-park/sit-for (pos seconds) (let ((p (point))) @@ -460,7 +463,7 @@ If the element is a function or a list of a function and a number, (let ((nl (- height (count-lines (point-min) (point))))) (when (> nl 0) (setq line (concat line "\n")) - (dotimes (i nl) + (dotimes (_ nl) (insert line)))) (goto-char start) (recenter 0) diff --git a/test/lisp/play/cookie1-resources/cookies b/test/lisp/play/cookie1-resources/cookies new file mode 100644 index 00000000000..7bf569fa7d6 --- /dev/null +++ b/test/lisp/play/cookie1-resources/cookies @@ -0,0 +1,8 @@ +This fortune intentionally left blank. +% +This fortune intentionally not included. +% +This fortune intentionally says nothing. +% +This fortune is false. +% diff --git a/test/lisp/play/cookie1-tests.el b/test/lisp/play/cookie1-tests.el new file mode 100644 index 00000000000..d63ecb972aa --- /dev/null +++ b/test/lisp/play/cookie1-tests.el @@ -0,0 +1,40 @@ +;;; fortune-tests.el --- Tests for fortune.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 . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'cookie1) + +(ert-deftest cookie1-tests-cookie () + (let ((fortune-file (ert-resource-file "cookies"))) + (should (string-match "\\`This fortune" + (cookie fortune-file))))) + +(ert-deftest cookie1-testss-cookie-apropos () + (let ((fortune-file (ert-resource-file "cookies"))) + (should (string-match "\\`This fortune" + (car (cookie-apropos "false" fortune-file)))) + (should (= (length (cookie-apropos "false" fortune-file)) 1)))) + +(provide 'fortune-tests) +;;; fortune-tests.el ends here From 843ca067dbee2555b91f3b08f7acc8a70915f383 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 02:07:55 +0100 Subject: [PATCH 091/297] Convert many manual cedet tests to ert * test/manual/cedet/cedet-utests.el (cedet-files-utest): Move test from here... * test/lisp/cedet/cedet-files-tests.el: ...to this new file. * test/manual/cedet/srecode-tests.el (srecode-document-function-comment-extract-test): Move test from here... * test/lisp/cedet/srecode/document-tests.el: ...to this new file. * test/manual/cedet/cedet-utests.el (inversion-unit-test): Move test from here... * test/lisp/cedet/inversion-tests.el: ...to this new file. * test/manual/cedet/semantic-tests.el (semantic-gcc-test-output-parser): Move test from here... * test/lisp/cedet/semantic/bovine/gcc-tests.el: ...to this new file. * test/manual/cedet/semantic-tests.el (semantic-test-data-cache): Move test from here... * test/lisp/cedet/semantic/fw-tests.el: ...to this new file. --- test/lisp/cedet/cedet-files-tests.el | 54 ++++++++ test/lisp/cedet/inversion-tests.el | 81 ++++++++++++ test/lisp/cedet/semantic/bovine/gcc-tests.el | 129 +++++++++++++++++++ test/lisp/cedet/semantic/fw-tests.el | 45 +++++++ test/lisp/cedet/srecode/document-tests.el | 80 ++++++++++++ test/manual/cedet/cedet-utests.el | 102 +-------------- test/manual/cedet/semantic-tests.el | 122 ------------------ test/manual/cedet/srecode-tests.el | 50 ------- 8 files changed, 393 insertions(+), 270 deletions(-) create mode 100644 test/lisp/cedet/cedet-files-tests.el create mode 100644 test/lisp/cedet/inversion-tests.el create mode 100644 test/lisp/cedet/semantic/bovine/gcc-tests.el create mode 100644 test/lisp/cedet/semantic/fw-tests.el create mode 100644 test/lisp/cedet/srecode/document-tests.el diff --git a/test/lisp/cedet/cedet-files-tests.el b/test/lisp/cedet/cedet-files-tests.el new file mode 100644 index 00000000000..5502d424314 --- /dev/null +++ b/test/lisp/cedet/cedet-files-tests.el @@ -0,0 +1,54 @@ +;;; cedet-files-tests.el --- Tests for cedet-files.el -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2021 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam + +;; 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 . + +;;; Commentary: + +;; Moved here from test/manual/cedet/cedet-utests.el + +;;; Code: + +(require 'ert) +(require 'cedet-files) + +(defvar cedet-files-utest-list + '( + ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" ) + ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" ) + ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" ) + ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" ) + ) + "List of different file names to test. +Each entry is a cons cell of ( FNAME . CONVERTED ) +where FNAME is some file name, and CONVERTED is what it should be +converted into.") + +(ert-deftest cedet-files-utest () + "Test out some file name conversions." + (interactive) + (dolist (FT cedet-files-utest-list) + (let ((dir->file (cedet-directory-name-to-file-name (car FT) t)) + (file->dir (cedet-file-name-to-directory-name (cdr FT) t))) + (should (string= (cdr FT) dir->file)) + (should (string= file->dir (car FT)))))) + +(provide 'cedet-files-tests) + +;;; cedet-files-tests.el ends here diff --git a/test/lisp/cedet/inversion-tests.el b/test/lisp/cedet/inversion-tests.el new file mode 100644 index 00000000000..c8b45d67ea1 --- /dev/null +++ b/test/lisp/cedet/inversion-tests.el @@ -0,0 +1,81 @@ +;;; inversion-tests.el --- Tests for inversion.el -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2021 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam + +;; 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 . + +;;; Commentary: + +;; Moved here from test/manual/cedet/cedet-utests.el + +;;; Code: + +(require 'inversion) +(require 'ert) + +(ert-deftest inversion-unit-test () + "Test inversion to make sure it can identify different version strings." + (interactive) + (let ((c1 (inversion-package-version 'inversion)) + (c1i (inversion-package-incompatibility-version 'inversion)) + (c2 (inversion-decode-version "1.3alpha2")) + (c3 (inversion-decode-version "1.3beta4")) + (c4 (inversion-decode-version "1.3 beta5")) + (c5 (inversion-decode-version "1.3.4")) + (c6 (inversion-decode-version "2.3alpha")) + (c7 (inversion-decode-version "1.3")) + (c8 (inversion-decode-version "1.3pre1")) + (c9 (inversion-decode-version "2.4 (patch 2)")) + (c10 (inversion-decode-version "2.4 (patch 3)")) + (c11 (inversion-decode-version "2.4.2.1")) + (c12 (inversion-decode-version "2.4.2.2"))) + (should (inversion-= c1 c1)) + (should (inversion-< c1i c1)) + (should (inversion-< c2 c3)) + (should (inversion-< c3 c4)) + (should (inversion-< c4 c5)) + (should (inversion-< c5 c6)) + (should (inversion-< c2 c4)) + (should (inversion-< c2 c5)) + (should (inversion-< c2 c6)) + (should (inversion-< c3 c5)) + (should (inversion-< c3 c6)) + (should (inversion-< c7 c6)) + (should (inversion-< c4 c7)) + (should (inversion-< c2 c7)) + (should (inversion-< c8 c6)) + (should (inversion-< c8 c7)) + (should (inversion-< c4 c8)) + (should (inversion-< c2 c8)) + (should (inversion-< c9 c10)) + (should (inversion-< c10 c11)) + (should (inversion-< c11 c12)) + ;; Negatives + (should-not (inversion-< c3 c2)) + (should-not (inversion-< c4 c3)) + (should-not (inversion-< c5 c4)) + (should-not (inversion-< c6 c5)) + (should-not (inversion-< c7 c2)) + (should-not (inversion-< c7 c8)) + (should-not (inversion-< c12 c11)) + ;; Test the tester on inversion + (should-not (inversion-test 'inversion inversion-version)) + (should (stringp (inversion-test 'inversion "0.0.0"))) + (should (stringp (inversion-test 'inversion "1000.0"))))) + +;;; inversion-tests.el ends here diff --git a/test/lisp/cedet/semantic/bovine/gcc-tests.el b/test/lisp/cedet/semantic/bovine/gcc-tests.el new file mode 100644 index 00000000000..e1a18c6c64c --- /dev/null +++ b/test/lisp/cedet/semantic/bovine/gcc-tests.el @@ -0,0 +1,129 @@ +;;; gcc-tests.el --- Tests for semantic/bovine/gcc.el -*- lexical-binding:t -*- + +;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam + +;; 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 . + +;;; Commentary: + +;; Moved here from test/manual/cedet/semantic-tests.el + +;;; Code: + +(require 'ert) +(require 'semantic/bovine/gcc) + +;;; From bovine-gcc: + +;; Example output of "gcc -v" +(defvar semantic-gcc-test-strings + '(;; My old box: + "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs +Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --host=i386-redhat-linux +Thread model: posix +gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)" + ;; Alex Ott: + "Using built-in specs. +Target: i486-linux-gnu +Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu +Thread model: posix +gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)" + ;; My debian box: + "Using built-in specs. +Target: x86_64-unknown-linux-gnu +Configured with: ../../../sources/gcc/configure --prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3 --with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr --enable-languages=c,c++,fortran --with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as --with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib +Thread model: posix +gcc version 4.2.3" + ;; My mac: + "Using built-in specs. +Target: i686-apple-darwin8 +Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure --disable-checking -enable-werror --prefix=/usr --mandir=/share/man --enable-languages=c,objc,c++,obj-c++ --program-transform-name=/^[cg][^.-]*$/s/$/-4.0/ --with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib --build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott --program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8 +Thread model: posix +gcc version 4.0.1 (Apple Computer, Inc. build 5341)" + ;; Ubuntu Intrepid + "Using built-in specs. +Target: x86_64-linux-gnu +Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu +Thread model: posix +gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" + ;; Red Hat EL4 + "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs +Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux +Thread model: posix +gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)" + ;; Red Hat EL5 + "Using built-in specs. +Target: x86_64-redhat-linux +Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-libgcj-multifile --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --enable-plugin --with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic --host=x86_64-redhat-linux +Thread model: posix +gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)" + ;; David Engster's german gcc on ubuntu 4.3 + "Es werden eingebaute Spezifikationen verwendet. +Ziel: i486-linux-gnu +Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu +Thread-Modell: posix +gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" + ;; Damien Deville bsd + "Using built-in specs. +Target: i386-undermydesk-freebsd +Configured with: FreeBSD/i386 system compiler +Thread model: posix +gcc version 4.2.1 20070719 [FreeBSD]" + ) + "A bunch of sample gcc -v outputs from different machines.") + +(defvar semantic-gcc-test-strings-fail + '(;; A really old solaris box I found + "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs +gcc version 2.95.2 19991024 (release)" + ) + "A bunch of sample gcc -v outputs that fail to provide the info we want.") + +(defun semantic-gcc-test-output-parser () + "Test the output parser against some collected strings." + (dolist (S semantic-gcc-test-strings) + (let* ((fields (semantic-gcc-fields S)) + (v (cdr (assoc 'version fields))) + (h (or (cdr (assoc 'target fields)) + (cdr (assoc '--target fields)) + (cdr (assoc '--host fields)))) + (p (cdr (assoc '--prefix fields)))) + ;; No longer test for prefixes. + (when (not (and v h)) + (let ((strs (split-string S "\n"))) + (error "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p))))) + (dolist (S semantic-gcc-test-strings-fail) + (let* ((fields (semantic-gcc-fields S)) + (v (cdr (assoc 'version fields))) + (h (or (cdr (assoc '--host fields)) + (cdr (assoc 'target fields)))) + (p (cdr (assoc '--prefix fields))) + ) + (when (and v h p) + (error "Negative test failed on %S" S))))) + +(ert-deftest semantic-gcc-test-output-parser () + (semantic-gcc-test-output-parser)) + +(ert-deftest semantic-gcc-test-output-parser-this-machine () + "Test the output parser against the machine currently running Emacs." + (skip-unless (executable-find "gcc")) + (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v")))) + (semantic-gcc-test-output-parser))) + +;;; gcc-tests.el ends here diff --git a/test/lisp/cedet/semantic/fw-tests.el b/test/lisp/cedet/semantic/fw-tests.el new file mode 100644 index 00000000000..62d665dbb6e --- /dev/null +++ b/test/lisp/cedet/semantic/fw-tests.el @@ -0,0 +1,45 @@ +;;; fw-tests.el --- Tests for semantic/fw.el -*- lexical-binding:t -*- + +;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam + +;; 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 . + +;;; Commentary: + +;; Moved here from test/manual/cedet/semantic-tests.el + +;;; Code: + +(require 'ert) +(require 'semantic/fw) + +;;; From semantic-fw: + +(ert-deftest semantic-test-data-cache () + "Test the data cache." + (let ((data '(a b c))) + (with-current-buffer (get-buffer-create " *semantic-test-data-cache*") + (erase-buffer) + (insert "The Moose is Loose") + (goto-char (point-min)) + (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5) + data 'moose 'exit-cache-zone) + ;; retrieve cached data + (should (equal (semantic-get-cache-data 'moose) data))))) + +;;; gw-tests.el ends here diff --git a/test/lisp/cedet/srecode/document-tests.el b/test/lisp/cedet/srecode/document-tests.el new file mode 100644 index 00000000000..0bc6e10d7a7 --- /dev/null +++ b/test/lisp/cedet/srecode/document-tests.el @@ -0,0 +1,80 @@ +;;; document-tests.el --- Tests for srecode/document.el -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2021 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam + +;; 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 . + +;;; Commentary: + +;; Extracted from srecode-document.el in the CEDET distribution. + +;; Converted to ert from test/manual/cedet/srecode-tests.el + +;;; Code: + +(require 'ert) +(require 'srecode/document) + +;; FIXME: This test fails even before conversion to ert. +(ert-deftest srecode-document-function-comment-extract-test () + "Test old comment extraction. +Dump out the extracted dictionary." + :tags '(:unstable) + (interactive) + + (srecode-load-tables-for-mode major-mode) + (srecode-load-tables-for-mode major-mode 'document) + + (should (srecode-table)) + ;; (error "No template table found for mode %s" major-mode) + + (let* ((temp (srecode-template-get-table (srecode-table) + "function-comment" + "declaration" + 'document)) + (fcn-in (semantic-current-tag))) + + (should temp) + ;; (error "No templates for function comments") + + ;; Try to figure out the tag we want to use. + (should fcn-in) + (should (semantic-tag-of-class-p fcn-in 'function)) + ;; (error "No tag of class 'function to insert comment for") + + (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))) + + (should lextok) + ;; (error "No comment to attempt an extraction") + + (let ((s (semantic-lex-token-start lextok)) + (e (semantic-lex-token-end lextok)) + (extract nil)) + + (pulse-momentary-highlight-region s e) + + ;; Extract text from the existing comment. + (setq extract (srecode-extract temp s e)) + + (with-output-to-temp-buffer "*SRECODE DUMP*" + (princ "EXTRACTED DICTIONARY FOR ") + (princ (semantic-tag-name fcn-in)) + (princ "\n--------------------------------------------\n") + (srecode-dump extract)))))) + +;;; document-tests.el ends here diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el index 7805fce2d12..94e5071352c 100644 --- a/test/manual/cedet/cedet-utests.el +++ b/test/manual/cedet/cedet-utests.el @@ -26,7 +26,6 @@ ;; into one command. (require 'cedet) -(require 'inversion) (defvar cedet-utest-directory (let* ((C (file-name-directory (locate-library "cedet"))) @@ -48,7 +47,7 @@ ;; ;; Test inversion - ("inversion" . inversion-unit-test) + ;; ("inversion" . inversion-unit-test) ; moved to automated suite ;; EZ Image dumping. ("ezimage associations" . ezimage-image-association-dump) @@ -60,7 +59,7 @@ ("pulse interactive test" . (lambda () (pulse-test t))) ;; Files - ("cedet file conversion" . cedet-files-utest) + ;; ("cedet file conversion" . cedet-files-utest) ; moved to automated suite ;; ;; EIEIO @@ -100,7 +99,7 @@ (message " ** Skipping test in noninteractive mode.") (semantic-test-throw-on-input)))) - ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser) + ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser) ; moved to automated suite ;; ;; SRECODE @@ -376,7 +375,7 @@ Optional argument PRECR indicates to prefix the done msg w/ a newline." (cedet-utest-add-log-item-start testname) )) -(defun cedet-utest-log(format &rest args) +(defun cedet-utest-log (format &rest args) "Log the text string FORMAT. The rest of the ARGS are used to fill in FORMAT with `format'." (if noninteractive @@ -392,99 +391,6 @@ The rest of the ARGS are used to fill in FORMAT with `format'." (cedet-utest-show-log-end) ) -;;; Inversion tests - -(defun inversion-unit-test () - "Test inversion to make sure it can identify different version strings." - (interactive) - (let ((c1 (inversion-package-version 'inversion)) - (c1i (inversion-package-incompatibility-version 'inversion)) - (c2 (inversion-decode-version "1.3alpha2")) - (c3 (inversion-decode-version "1.3beta4")) - (c4 (inversion-decode-version "1.3 beta5")) - (c5 (inversion-decode-version "1.3.4")) - (c6 (inversion-decode-version "2.3alpha")) - (c7 (inversion-decode-version "1.3")) - (c8 (inversion-decode-version "1.3pre1")) - (c9 (inversion-decode-version "2.4 (patch 2)")) - (c10 (inversion-decode-version "2.4 (patch 3)")) - (c11 (inversion-decode-version "2.4.2.1")) - (c12 (inversion-decode-version "2.4.2.2")) - ) - (if (not (and - (inversion-= c1 c1) - (inversion-< c1i c1) - (inversion-< c2 c3) - (inversion-< c3 c4) - (inversion-< c4 c5) - (inversion-< c5 c6) - (inversion-< c2 c4) - (inversion-< c2 c5) - (inversion-< c2 c6) - (inversion-< c3 c5) - (inversion-< c3 c6) - (inversion-< c7 c6) - (inversion-< c4 c7) - (inversion-< c2 c7) - (inversion-< c8 c6) - (inversion-< c8 c7) - (inversion-< c4 c8) - (inversion-< c2 c8) - (inversion-< c9 c10) - (inversion-< c10 c11) - (inversion-< c11 c12) - ;; Negatives - (not (inversion-< c3 c2)) - (not (inversion-< c4 c3)) - (not (inversion-< c5 c4)) - (not (inversion-< c6 c5)) - (not (inversion-< c7 c2)) - (not (inversion-< c7 c8)) - (not (inversion-< c12 c11)) - ;; Test the tester on inversion - (not (inversion-test 'inversion inversion-version)) - ;; Test that we throw an error - (inversion-test 'inversion "0.0.0") - (inversion-test 'inversion "1000.0") - )) - (error "Inversion tests failed") - (message "Inversion tests passed.")))) - -;;; cedet-files unit test - -(defvar cedet-files-utest-list - '( - ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" ) - ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" ) - ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" ) - ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" ) - ) - "List of different file names to test. -Each entry is a cons cell of ( FNAME . CONVERTED ) -where FNAME is some file name, and CONVERTED is what it should be -converted into.") - -(defun cedet-files-utest () - "Test out some file name conversions." - (interactive) - (let ((idx 0)) - (dolist (FT cedet-files-utest-list) - - (setq idx (+ idx 1)) - - (let ((dir->file (cedet-directory-name-to-file-name (car FT) t)) - (file->dir (cedet-file-name-to-directory-name (cdr FT) t)) - ) - - (unless (string= (cdr FT) dir->file) - (error "Failed: %d. Found: %S Wanted: %S" - idx dir->file (cdr FT)) - ) - - (unless (string= file->dir (car FT)) - (error "Failed: %d. Found: %S Wanted: %S" - idx file->dir (car FT))))))) - ;;; pulse test (defun pulse-test (&optional no-error) diff --git a/test/manual/cedet/semantic-tests.el b/test/manual/cedet/semantic-tests.el index 716bcc7abed..3d72fa2965a 100644 --- a/test/manual/cedet/semantic-tests.el +++ b/test/manual/cedet/semantic-tests.el @@ -138,21 +138,6 @@ Optional argument ARG specifies not to use color." (require 'semantic/fw) -(defun semantic-test-data-cache () - "Test the data cache." - (interactive) - (let ((data '(a b c))) - (save-excursion - (set-buffer (get-buffer-create " *semantic-test-data-cache*")) - (erase-buffer) - (insert "The Moose is Loose") - (goto-char (point-min)) - (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5) - data 'moose 'exit-cache-zone) - (if (equal (semantic-get-cache-data 'moose) data) - (message "Successfully retrieved cached data.") - (error "Failed to retrieve cached data"))))) - (defun semantic-test-throw-on-input () "Test that throw on input will work." (interactive) @@ -281,110 +266,3 @@ tag that contains point, and return that." Lcount (semantic-tag-name target) (semantic-elapsed-time start nil))) Lcount))) - -;;; From bovine-gcc: - -(require 'semantic/bovine/gcc) - -;; Example output of "gcc -v" -(defvar semantic-gcc-test-strings - '(;; My old box: - "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs -Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --host=i386-redhat-linux -Thread model: posix -gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)" - ;; Alex Ott: - "Using built-in specs. -Target: i486-linux-gnu -Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu -Thread model: posix -gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)" - ;; My debian box: - "Using built-in specs. -Target: x86_64-unknown-linux-gnu -Configured with: ../../../sources/gcc/configure --prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3 --with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr --enable-languages=c,c++,fortran --with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as --with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib -Thread model: posix -gcc version 4.2.3" - ;; My mac: - "Using built-in specs. -Target: i686-apple-darwin8 -Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure --disable-checking -enable-werror --prefix=/usr --mandir=/share/man --enable-languages=c,objc,c++,obj-c++ --program-transform-name=/^[cg][^.-]*$/s/$/-4.0/ --with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib --build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott --program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8 -Thread model: posix -gcc version 4.0.1 (Apple Computer, Inc. build 5341)" - ;; Ubuntu Intrepid - "Using built-in specs. -Target: x86_64-linux-gnu -Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu -Thread model: posix -gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" - ;; Red Hat EL4 - "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs -Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux -Thread model: posix -gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)" - ;; Red Hat EL5 - "Using built-in specs. -Target: x86_64-redhat-linux -Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-libgcj-multifile --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --enable-plugin --with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic --host=x86_64-redhat-linux -Thread model: posix -gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)" - ;; David Engster's german gcc on ubuntu 4.3 - "Es werden eingebaute Spezifikationen verwendet. -Ziel: i486-linux-gnu -Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu -Thread-Modell: posix -gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" - ;; Damien Deville bsd - "Using built-in specs. -Target: i386-undermydesk-freebsd -Configured with: FreeBSD/i386 system compiler -Thread model: posix -gcc version 4.2.1 20070719 [FreeBSD]" - ) - "A bunch of sample gcc -v outputs from different machines.") - -(defvar semantic-gcc-test-strings-fail - '(;; A really old solaris box I found - "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs -gcc version 2.95.2 19991024 (release)" - ) - "A bunch of sample gcc -v outputs that fail to provide the info we want.") - -(defun semantic-gcc-test-output-parser () - "Test the output parser against some collected strings." - (interactive) - (let ((fail nil)) - (dolist (S semantic-gcc-test-strings) - (let* ((fields (semantic-gcc-fields S)) - (v (cdr (assoc 'version fields))) - (h (or (cdr (assoc 'target fields)) - (cdr (assoc '--target fields)) - (cdr (assoc '--host fields)))) - (p (cdr (assoc '--prefix fields))) - ) - ;; No longer test for prefixes. - (when (not (and v h)) - (let ((strs (split-string S "\n"))) - (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)) - (setq fail t)) - )) - (dolist (S semantic-gcc-test-strings-fail) - (let* ((fields (semantic-gcc-fields S)) - (v (cdr (assoc 'version fields))) - (h (or (cdr (assoc '--host fields)) - (cdr (assoc 'target fields)))) - (p (cdr (assoc '--prefix fields))) - ) - (when (and v h p) - (message "Negative test failed on %S" S) - (setq fail t)) - )) - (if (not fail) (message "Tests passed.")) - )) - -(defun semantic-gcc-test-output-parser-this-machine () - "Test the output parser against the machine currently running Emacs." - (interactive) - (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v")))) - (semantic-gcc-test-output-parser)) - ) diff --git a/test/manual/cedet/srecode-tests.el b/test/manual/cedet/srecode-tests.el index ebc3261f817..483074078b0 100644 --- a/test/manual/cedet/srecode-tests.el +++ b/test/manual/cedet/srecode-tests.el @@ -241,54 +241,4 @@ It is filled with some text." (message " All field tests passed.") )) -;;; From srecode-document: - -(require 'srecode/document) - -(defun srecode-document-function-comment-extract-test () - "Test old comment extraction. -Dump out the extracted dictionary." - (interactive) - - (srecode-load-tables-for-mode major-mode) - (srecode-load-tables-for-mode major-mode 'document) - - (if (not (srecode-table)) - (error "No template table found for mode %s" major-mode)) - - (let* ((temp (srecode-template-get-table (srecode-table) - "function-comment" - "declaration" - 'document)) - (fcn-in (semantic-current-tag))) - - (if (not temp) - (error "No templates for function comments")) - - ;; Try to figure out the tag we want to use. - (when (or (not fcn-in) - (not (semantic-tag-of-class-p fcn-in 'function))) - (error "No tag of class 'function to insert comment for")) - - (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex)) - ) - - (when (not lextok) - (error "No comment to attempt an extraction")) - - (let ((s (semantic-lex-token-start lextok)) - (e (semantic-lex-token-end lextok)) - (extract nil)) - - (pulse-momentary-highlight-region s e) - - ;; Extract text from the existing comment. - (setq extract (srecode-extract temp s e)) - - (with-output-to-temp-buffer "*SRECODE DUMP*" - (princ "EXTRACTED DICTIONARY FOR ") - (princ (semantic-tag-name fcn-in)) - (princ "\n--------------------------------------------\n") - (srecode-dump extract)))))) - ;;; srecode-tests.el ends here From 45934e51e427712b96ff3b58a940d9327d15468d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 03:02:03 +0100 Subject: [PATCH 092/297] Change default semantic-lex-analyzer to semantic-lex * lisp/cedet/semantic/lex.el (semantic-lex-analyzer): Change default to semantic-lex, since semantic-flex was obsolete and has been removed. --- lisp/cedet/semantic/lex.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 4cafc7d4fe7..ae70d5c730a 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -469,11 +469,9 @@ PROPERTY set." ;;; Lexical Analyzer framework settings ;; -;; FIXME change to non-obsolete default. -(defvar-local semantic-lex-analyzer 'semantic-flex +(defvar-local semantic-lex-analyzer 'semantic-lex "The lexical analyzer used for a given buffer. -See `semantic-lex' for documentation. -For compatibility with Semantic 1.x it defaults to `semantic-flex'.") +See `semantic-lex' for documentation.") (defvar semantic-lex-tokens '( From 18ad1388d00e40a031bead1d0b5a0ae429dcc8ad Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 03:06:27 +0100 Subject: [PATCH 093/297] Use lexical-binding in some test files * test/manual/cedet/ede-tests.el: * test/manual/cedet/srecode-tests.el: * test/manual/cedet/tests/test.el: Use lexical-binding. * test/manual/etags/el-src/TAGTEST.EL: Add lexical-binding cookie. * test/manual/etags/ETAGS.good_1: Update expected result for the above change. --- test/manual/cedet/ede-tests.el | 14 +++++--------- test/manual/cedet/srecode-tests.el | 2 +- test/manual/cedet/tests/test.el | 2 +- test/manual/etags/ETAGS.good_1 | 10 +++++----- test/manual/etags/el-src/TAGTEST.EL | 2 ++ 5 files changed, 14 insertions(+), 16 deletions(-) diff --git a/test/manual/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el index eb3132398a6..2af50860c60 100644 --- a/test/manual/cedet/ede-tests.el +++ b/test/manual/cedet/ede-tests.el @@ -1,4 +1,4 @@ -;;; ede-tests.el --- Some tests for the Emacs Development Environment +;;; ede-tests.el --- Some tests for the Emacs Development Environment -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -42,8 +42,7 @@ The search is done with the current EDE root." (ede-toplevel))))) (data-debug-new-buffer "*EDE Locate ADEBUG*") (ede-locate-file-in-project loc file) - (data-debug-insert-object-slots loc "]")) - ) + (data-debug-insert-object-slots loc "]"))) (defun ede-locate-test-global (file) "Test EDE Locate on FILE using GNU Global type. @@ -55,8 +54,7 @@ The search is done with the current EDE root." (ede-toplevel))))) (data-debug-new-buffer "*EDE Locate ADEBUG*") (ede-locate-file-in-project loc file) - (data-debug-insert-object-slots loc "]")) - ) + (data-debug-insert-object-slots loc "]"))) (defun ede-locate-test-idutils (file) "Test EDE Locate on FILE using ID Utils type. @@ -68,8 +66,7 @@ The search is done with the current EDE root." (ede-toplevel))))) (data-debug-new-buffer "*EDE Locate ADEBUG*") (ede-locate-file-in-project loc file) - (data-debug-insert-object-slots loc "]")) - ) + (data-debug-insert-object-slots loc "]"))) (defun ede-locate-test-cscope (file) "Test EDE Locate on FILE using CScope type. @@ -81,7 +78,6 @@ The search is done with the current EDE root." (ede-toplevel))))) (data-debug-new-buffer "*EDE Locate ADEBUG*") (ede-locate-file-in-project loc file) - (data-debug-insert-object-slots loc "]")) - ) + (data-debug-insert-object-slots loc "]"))) ;;; ede-test.el ends here diff --git a/test/manual/cedet/srecode-tests.el b/test/manual/cedet/srecode-tests.el index 483074078b0..18ca07343d6 100644 --- a/test/manual/cedet/srecode-tests.el +++ b/test/manual/cedet/srecode-tests.el @@ -1,4 +1,4 @@ -;;; srecode-tests.el --- Some tests for CEDET's srecode +;;; srecode-tests.el --- Some tests for CEDET's srecode -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el index 3bc945d89f8..a54c253be68 100644 --- a/test/manual/cedet/tests/test.el +++ b/test/manual/cedet/tests/test.el @@ -1,4 +1,4 @@ -;;; test.el --- Unit test file for Semantic Emacs Lisp support. +;;; test.el --- Unit test file for Semantic Emacs Lisp support. -*- lexical-binding: t -*- ;; Copyright (C) 2005-2021 Free Software Foundation, Inc. diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1 index 3de15514e79..e6b060f3352 100644 --- a/test/manual/etags/ETAGS.good_1 +++ b/test/manual/etags/ETAGS.good_1 @@ -2143,11 +2143,11 @@ main(37,571 class D 41,622 D(43,659 -el-src/TAGTEST.EL,179 -(foo::defmumble bletch 1,0 -(defun foo==bar foo==bar2,33 -(defalias 'pending-delete-mode pending-delete-mode6,149 -(defalias (quote explicitly-quoted-pending-delete-mode)9,222 +el-src/TAGTEST.EL,181 +(foo::defmumble bletch 3,33 +(defun foo==bar foo==bar4,66 +(defalias 'pending-delete-mode pending-delete-mode8,182 +(defalias (quote explicitly-quoted-pending-delete-mode)11,255 el-src/emacs/lisp/progmodes/etags.el,5069 (defvar tags-file-name 34,1035 diff --git a/test/manual/etags/el-src/TAGTEST.EL b/test/manual/etags/el-src/TAGTEST.EL index 89a67913771..3e6599a4a45 100644 --- a/test/manual/etags/el-src/TAGTEST.EL +++ b/test/manual/etags/el-src/TAGTEST.EL @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + (foo::defmumble bletch beuarghh) (defun foo==bar () (message "hi")) ; Bug#5624 ;;; Ctags test file for lisp mode. From c07459fd10a9352b32d4de6e9145a419772bd70b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 04:14:48 +0100 Subject: [PATCH 094/297] Move semantic/format.el tests to follow our conventions * test/lisp/cedet/semantic-utest-fmt.el: Move from here... * test/lisp/cedet/semantic/format-tests.el: ...to here. (ert, ert-x): Require. (semantic-fmt-utest-file-list): Use ert-resource-file. * test/manual/cedet/tests/test-fmt.cpp: * test/manual/cedet/tests/test-fmt.el: Move from here... * test/lisp/cedet/semantic/format-resources/test-fmt.cpp: * test/lisp/cedet/semantic/format-resources/test-fmt.el: ...to here. --- .../semantic/format-resources}/test-fmt.cpp | 0 .../semantic/format-resources}/test-fmt.el | 2 +- .../format-tests.el} | 38 ++++++------------- 3 files changed, 12 insertions(+), 28 deletions(-) rename test/{manual/cedet/tests => lisp/cedet/semantic/format-resources}/test-fmt.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic/format-resources}/test-fmt.el (95%) rename test/lisp/cedet/{semantic-utest-fmt.el => semantic/format-tests.el} (79%) diff --git a/test/manual/cedet/tests/test-fmt.cpp b/test/lisp/cedet/semantic/format-resources/test-fmt.cpp similarity index 100% rename from test/manual/cedet/tests/test-fmt.cpp rename to test/lisp/cedet/semantic/format-resources/test-fmt.cpp diff --git a/test/manual/cedet/tests/test-fmt.el b/test/lisp/cedet/semantic/format-resources/test-fmt.el similarity index 95% rename from test/manual/cedet/tests/test-fmt.el rename to test/lisp/cedet/semantic/format-resources/test-fmt.el index 122571323b2..941aaae8595 100644 --- a/test/manual/cedet/tests/test-fmt.el +++ b/test/lisp/cedet/semantic/format-resources/test-fmt.el @@ -1,4 +1,4 @@ -;;; test-fmt.el --- test semantic tag formatting +;;; test-fmt.el --- test semantic tag formatting -*- lexical-binding: t -*- ;;; Copyright (C) 2012, 2019-2021 Free Software Foundation, Inc. diff --git a/test/lisp/cedet/semantic-utest-fmt.el b/test/lisp/cedet/semantic/format-tests.el similarity index 79% rename from test/lisp/cedet/semantic-utest-fmt.el rename to test/lisp/cedet/semantic/format-tests.el index d6e5ce7a0fd..a9eb4489d59 100644 --- a/test/lisp/cedet/semantic-utest-fmt.el +++ b/test/lisp/cedet/semantic/format-tests.el @@ -1,4 +1,4 @@ -;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests -*- lexical-binding:t -*- +;;; semantic/format-tests.el --- Parsing / Formatting tests -*- lexical-binding:t -*- ;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc. @@ -28,19 +28,14 @@ ;; make sure that the semantic-tag-format-* functions in question ;; created the desired output. -(require 'semantic) -(require 'semantic/format) - ;;; Code: -(defvar cedet-utest-directory - (let* ((C (file-name-directory (locate-library "cedet"))) - (D (expand-file-name "../../test/manual/cedet/" C))) - D) - "Location of test files for this test suite.") +(require 'ert) +(require 'ert-x) +(require 'semantic/format) (defvar semantic-fmt-utest-file-list - '("tests/test-fmt.cpp" + (list (ert-resource-file "test-fmt.cpp") ;; "tests/test-fmt.el" - add this when elisp is support by dflt in Emacs ) "List of files to run unit tests in.") @@ -53,21 +48,10 @@ Files to visit are in `semantic-fmt-utest-file-list'." (save-current-buffer (semantic-mode 1) - (let ((fl semantic-fmt-utest-file-list) - (fname nil) - ) - - (dolist (FILE fl) - - (save-current-buffer - (setq fname (expand-file-name FILE cedet-utest-directory)) - - ;; Make sure we have the files we think we have. - (should (file-exists-p fname)) - ;; (error "Cannot find unit test file: %s" fname)) - - ;; Run the tests. - (let ((fb (find-buffer-visiting fname)) + (let ((fl semantic-fmt-utest-file-list)) + (dolist (fname fl) + (save-current-buffer + (let ((fb (find-buffer-visiting fname)) (b (semantic-find-file-noselect fname)) (tags nil)) @@ -122,6 +106,6 @@ Files to visit are in `semantic-fmt-utest-file-list'." ))) -(provide 'cedet/semantic/fmt-utest) +(provide 'format-tests) -;;; semantic-fmt-utest.el ends here +;;; format-tests.el ends here From f0f548095358c8969847e7dc2ac4ba7bd8bb80b7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 04:42:37 +0100 Subject: [PATCH 095/297] Use lexical-binding in bib-mode.el * lisp/textmodes/bib-mode.el: Use lexical-binding. Remove redundant :group args. --- lisp/textmodes/bib-mode.el | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 1e22287d32e..ec21987bbf5 100644 --- a/lisp/textmodes/bib-mode.el +++ b/lisp/textmodes/bib-mode.el @@ -1,4 +1,4 @@ -;;; bib-mode.el --- major mode for editing bib files +;;; bib-mode.el --- major mode for editing bib files -*- lexical-binding: t -*- ;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc. @@ -39,13 +39,11 @@ (defcustom bib-file "~/my-bibliography.bib" "Default name of file used by `addbib'." - :type 'file - :group 'bib) + :type 'file) (defcustom unread-bib-file "~/to-be-read.bib" "Default name of file used by `unread-bib' in Bib mode." - :type 'file - :group 'bib) + :type 'file) (defvar bib-mode-map (let ((map (make-sparse-keymap))) @@ -138,8 +136,7 @@ with the cdr.") (defcustom bib-auto-capitalize t "True to automatically capitalize appropriate fields in Bib mode." - :type 'boolean - :group 'bib) + :type 'boolean) (defconst bib-capitalized-fields "%[AETCBIJR]") From c735ec94545d1ca726d6cdcfdf4b0847e55330d9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 04:48:43 +0100 Subject: [PATCH 096/297] Make texinfmt-version variable obsolete * lisp/textmodes/texinfmt.el (texinfmt-version): Make variable and command obsolete in favour of 'emacs-version'. (texinfo-format-region, texinfo-format-buffer-1): Use 'emacs-version' instead of above obsolete variable. --- lisp/textmodes/texinfmt.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index ed0a367d01d..fe052e32414 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -28,10 +28,12 @@ ;;; Emacs lisp functions to convert Texinfo files to Info files. (defvar texinfmt-version "2.42 of 7 Jul 2006") +(make-obsolete-variable 'texinfmt-version 'emacs-version "28.1") (defun texinfmt-version (&optional here) "Show the version of texinfmt.el in the minibuffer. If optional argument HERE is non-nil, insert info at point." + (declare (obsolete emacs-version "28.1")) (interactive "P") (let ((version-string (format-message "Version of `texinfmt.el': %s" texinfmt-version))) @@ -345,8 +347,8 @@ converted to Info is stored in a temporary buffer." (file-name-nondirectory (buffer-file-name input-buffer)))) (format-message "buffer `%s'" (buffer-name input-buffer))) - (format-message "\nusing `texinfmt.el' version ") - texinfmt-version + (format-message "\nusing `texinfmt.el' on Emacs version ") + emacs-version ".\n\n") ;; Now convert for real. @@ -489,8 +491,8 @@ if large. You can use `Info-split' to do this manually." (file-name-nondirectory (buffer-file-name input-buffer)))) (format-message "buffer `%s'" (buffer-name input-buffer))) - (format-message "\nusing `texinfmt.el' version ") - texinfmt-version + (format-message "\nusing `texinfmt.el' on Emacs version ") + emacs-version ".\n\n") ;; Return data for indices. (list outfile From def546679fd93a4a1d049d9d3021166bf66a0e26 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 06:40:13 +0100 Subject: [PATCH 097/297] ; * test/lisp/cedet/semantic/format-tests.el: Minor cleanup. --- test/lisp/cedet/semantic/format-tests.el | 100 ++++++++++------------- 1 file changed, 42 insertions(+), 58 deletions(-) diff --git a/test/lisp/cedet/semantic/format-tests.el b/test/lisp/cedet/semantic/format-tests.el index a9eb4489d59..e82c97b4c43 100644 --- a/test/lisp/cedet/semantic/format-tests.el +++ b/test/lisp/cedet/semantic/format-tests.el @@ -20,7 +20,7 @@ ;; along with GNU Emacs. If not, see . ;;; Commentary: -;; + ;; Unit tests for the formatting feature. ;; ;; Using test code from the tests source directory, parse the source @@ -40,71 +40,55 @@ ) "List of files to run unit tests in.") -(defvar semantic-fmt-utest-error-log-list nil - "Log errors during testing in this variable.") - (ert-deftest semantic-fmt-utest () - "Visit all file entries, and run formatting test. -Files to visit are in `semantic-fmt-utest-file-list'." + "Visit all file entries, and run formatting test. " (save-current-buffer (semantic-mode 1) - (let ((fl semantic-fmt-utest-file-list)) - (dolist (fname fl) + (dolist (fname semantic-fmt-utest-file-list) + (let ((fb (find-buffer-visiting fname)) + (b (semantic-find-file-noselect fname)) + (tags nil)) (save-current-buffer - (let ((fb (find-buffer-visiting fname)) - (b (semantic-find-file-noselect fname)) - (tags nil)) + (set-buffer b) + (should (semantic-active-p)) + ;;(error "Cannot open %s for format tests" fname)) - (save-current-buffer - (set-buffer b) - (should (semantic-active-p)) - ;;(error "Cannot open %s for format tests" fname)) + ;; This will force a reparse, removing any chance of semanticdb cache + ;; using stale data. + (semantic-clear-toplevel-cache) + ;; Force the reparse + (setq tags (semantic-fetch-tags)) - ;; This will force a reparse, removing any chance of semanticdb cache - ;; using stale data. - (semantic-clear-toplevel-cache) - ;; Force the reparse - (setq tags (semantic-fetch-tags)) + (save-excursion + (while tags + (let* ((T (car tags)) + (start (semantic-tag-end T)) + (end (if (cdr tags) + (semantic-tag-start (car (cdr tags))) + (point-max))) + (TESTS nil)) + (goto-char start) + ;; Scan the space between tags for all test condition matches. + (while (re-search-forward "## \\([a-z-]+\\) \"\\([^\n\"]+\\)\"$" end t) + (push (cons (match-string 1) (match-string 2)) TESTS)) + (setq TESTS (nreverse TESTS)) - (save-excursion - (while tags - (let* ((T (car tags)) - (start (semantic-tag-end T)) - (end (if (cdr tags) - (semantic-tag-start (car (cdr tags))) - (point-max))) - (TESTS nil) - ) - (goto-char start) - ;; Scan the space between tags for all test condition matches. - (while (re-search-forward "## \\([a-z-]+\\) \"\\([^\n\"]+\\)\"$" end t) - (push (cons (match-string 1) (match-string 2)) TESTS)) - (setq TESTS (nreverse TESTS)) - - (dolist (TST TESTS) - (let* ( ;; For each test, convert CAR into a semantic-format-tag* fcn - (sym (intern (concat "semantic-format-tag-" (car TST)))) - ;; Convert the desired result from a string syntax to a string. - (desired (cdr TST)) - ;; What does the fmt function do? - (actual (funcall sym T)) - ) - (when (not (string= desired actual)) - (should-not (list "Desired" desired - "Actual" actual - "Formatter" (car TST)))) - ))) - (setq tags (cdr tags))) - - )) - - ;; If it wasn't already in memory, whack it. - (when (and b (not fb)) - (kill-buffer b))) - )) - - ))) + (dolist (TST TESTS) + (let* ( ;; For each test, convert CAR into a semantic-format-tag* fcn + (sym (intern (concat "semantic-format-tag-" (car TST)))) + ;; Convert the desired result from a string syntax to a string. + (desired (cdr TST)) + ;; What does the fmt function do? + (actual (funcall sym T))) + (when (not (string= desired actual)) + (should-not (list "Desired" desired + "Actual" actual + "Formatter" (car TST))))))) + (setq tags (cdr tags))))) + ;; If it wasn't already in memory, whack it. + (when (and b (not fb)) + (kill-buffer b)))))) (provide 'format-tests) From 62ee5999a725b0561c625277e3756657de9e4360 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 12:20:32 +0100 Subject: [PATCH 098/297] Convert tests for srecode/fields.el to ert * test/manual/cedet/srecode-tests.el: Move from here... * test/lisp/cedet/srecode/fields-tests.el: ...to here. (srecode-field-utest-impl): Convert test to ert. Silence byte-compiler. * test/manual/cedet/cedet-utests.el (cedet-utest-libs): Don't list the above moved file. --- .../cedet/srecode/fields-tests.el} | 44 ++++++++----------- test/manual/cedet/cedet-utests.el | 3 +- 2 files changed, 20 insertions(+), 27 deletions(-) rename test/{manual/cedet/srecode-tests.el => lisp/cedet/srecode/fields-tests.el} (88%) diff --git a/test/manual/cedet/srecode-tests.el b/test/lisp/cedet/srecode/fields-tests.el similarity index 88% rename from test/manual/cedet/srecode-tests.el rename to test/lisp/cedet/srecode/fields-tests.el index 18ca07343d6..5f634a5e4ce 100644 --- a/test/manual/cedet/srecode-tests.el +++ b/test/lisp/cedet/srecode/fields-tests.el @@ -1,4 +1,4 @@ -;;; srecode-tests.el --- Some tests for CEDET's srecode -*- lexical-binding: t -*- +;;; srecode/fields-tests.el --- Tests for srecode/fields.el -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -21,13 +21,15 @@ ;;; Commentary: -;; Extracted from srecode-fields.el and srecode-document.el in the -;; CEDET distribution. +;; Extracted from srecode-fields.el in the CEDET distribution. + +;; Converted to ert from test/manual/cedet/srecode-tests.el ;;; Code: ;;; From srecode-fields: +(require 'ert) (require 'srecode/fields) (defvar srecode-field-utest-text @@ -36,13 +38,10 @@ It is filled with some text." "Text for tests.") -(defun srecode-field-utest () - "Test the srecode field manager." - (interactive) - (srecode-field-utest-impl)) - -(defun srecode-field-utest-impl () +;; FIXME: This test fails even before conversion to ert. +(ert-deftest srecode-field-utest-impl () "Implementation of the SRecode field utest." + :tags '(:unstable) (save-excursion (find-file "/tmp/srecode-field-test.txt") @@ -131,15 +130,15 @@ It is filled with some text." ;; Various sizes (mapc (lambda (T) - (if (string= (object-name-string T) "Test4") + (if (string= (eieio-object-name-string T) "Test4") (progn (when (not (srecode-empty-region-p T)) (error "Field %s is not empty" - (object-name T))) + (eieio-object-name T))) ) (when (not (= (srecode-region-size T) 5)) (error "Calculated size of %s was not 5" - (object-name T))))) + (eieio-object-name T))))) fields) ;; Make sure things stay up after a 'command'. @@ -151,21 +150,21 @@ It is filled with some text." (when (not (eq (srecode-overlaid-at-point 'srecode-field) (nth 0 fields))) (error "Region Test: Field %s not under point" - (object-name (nth 0 fields)))) + (eieio-object-name (nth 0 fields)))) (srecode-field-next) (when (not (eq (srecode-overlaid-at-point 'srecode-field) (nth 1 fields))) (error "Region Test: Field %s not under point" - (object-name (nth 1 fields)))) + (eieio-object-name (nth 1 fields)))) (srecode-field-prev) (when (not (eq (srecode-overlaid-at-point 'srecode-field) (nth 0 fields))) (error "Region Test: Field %s not under point" - (object-name (nth 0 fields)))) + (eieio-object-name (nth 0 fields)))) ;; Move cursor out of the region and have everything cleaned up. (goto-char 42) @@ -176,7 +175,7 @@ It is filled with some text." (mapc (lambda (T) (when (slot-boundp T 'overlay) (error "Overlay did not clear off of field %s" - (object-name T)))) + (eieio-object-name T)))) fields) ;; End of LET @@ -187,8 +186,7 @@ It is filled with some text." (f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8)) (f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30)) (f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40)) - (reg (srecode-template-inserted-region "REG" :start 4 :end 40)) - ) + (reg (srecode-template-inserted-region "REG" :start 4 :end 40))) (srecode-overlaid-activate reg) (when (not (string= (srecode-overlaid-text f1) @@ -233,12 +231,8 @@ It is filled with some text." (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) ;; Cleanup - (srecode-delete reg) - ) + (srecode-delete reg)) - (set-buffer-modified-p nil) + (set-buffer-modified-p nil))) - (message " All field tests passed.") - )) - -;;; srecode-tests.el ends here +;;; srecode/fields-tests.el ends here diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el index 94e5071352c..e421054102d 100644 --- a/test/manual/cedet/cedet-utests.el +++ b/test/manual/cedet/cedet-utests.el @@ -35,7 +35,6 @@ (defvar cedet-utest-libs '("ede-tests" "semantic-tests" - "srecode-tests" ) "List of test srcs that need to be loaded.") @@ -106,7 +105,7 @@ ;; ;; TODO - fix the fields test - ;;("srecode: fields" . srecode-field-utest) + ;;("srecode: fields" . srecode-field-utest) ; moved to automated suite ;;("srecode: templates" . srecode-utest-template-output) ("srecode: show maps" . srecode-get-maps) ;;("srecode: getset" . srecode-utest-getset-output) From 4786353b2abc756d3fd6bda016859b40ba9aca8a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 12:44:07 +0100 Subject: [PATCH 099/297] Move cedet test resource files to follow our conventions * test/lisp/cedet/semantic-utest-ia.el (ert, ert-x): Require. (cedet-utest-directory, semantic-utest-test-directory): Remove variables. (semantic-utest-ia-doublens.cpp, semantic-utest-ia-subclass.cpp) (semantic-utest-ia-typedefs.cpp, semantic-utest-ia-struct.cpp) (semantic-utest-ia-templates.cpp, semantic-utest-ia-using.cpp) (semantic-utest-ia-nsp.cpp, semantic-utest-ia-localvars.cpp) (semantic-utest-ia-namespace.cpp) (semantic-utest-ia-sppcomplete.c, semantic-utest-ia-varnames.c) (semantic-utest-ia-javacomp.java) (semantic-utest-ia-varnames.java, semantic-utest-ia-wisent.wy) (semantic-utest-ia-texi, semantic-utest-ia-make) (semantic-utest-ia-srecoder): Use 'ert-resource-file'. Don't check if file exists; we can assume that it does. * test/manual/cedet/tests/testjavacomp.java: * test/manual/cedet/tests/testlocalvars.cpp: * test/manual/cedet/tests/testnsp.cpp: * test/manual/cedet/tests/testsppcomplete.c: * test/manual/cedet/tests/teststruct.cpp: * test/manual/cedet/tests/testsubclass.cpp: * test/manual/cedet/tests/testsubclass.hh: * test/manual/cedet/tests/testtemplates.cpp: * test/manual/cedet/tests/testtypedefs.cpp: * test/manual/cedet/tests/testusing.cpp: * test/manual/cedet/tests/testusing.hh: * test/manual/cedet/tests/testvarnames.c: * test/manual/cedet/tests/testvarnames.java: * test/manual/cedet/tests/testwisent.wy: Move from here... * test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java: * test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp: * test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp: * test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c: * test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp: * test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp: * test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh: * test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp: * test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp: * test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp: * test/lisp/cedet/semantic-utest-ia-resources/testusing.hh: * test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c: * test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java: * test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy: ...to here. --- .../semantic-utest-ia-resources}/test.mk | 0 .../semantic-utest-ia-resources}/test.srt | 0 .../semantic-utest-ia-resources}/test.texi | 0 .../testdoublens.cpp | 0 .../testdoublens.hpp | 0 .../testfriends.cpp | 1 - .../testjavacomp.java | 0 .../testlocalvars.cpp | 0 .../semantic-utest-ia-resources}/testnsp.cpp | 0 .../testsppcomplete.c | 0 .../teststruct.cpp | 0 .../testsubclass.cpp | 0 .../testsubclass.hh | 0 .../testtemplates.cpp | 0 .../testtypedefs.cpp | 0 .../testusing.cpp | 0 .../semantic-utest-ia-resources}/testusing.hh | 0 .../testvarnames.c | 0 .../testvarnames.java | 0 .../testwisent.wy | 0 test/lisp/cedet/semantic-utest-ia.el | 71 ++++++------------- 21 files changed, 22 insertions(+), 50 deletions(-) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/test.mk (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/test.srt (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/test.texi (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testdoublens.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testdoublens.hpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testfriends.cpp (99%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testjavacomp.java (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testlocalvars.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testnsp.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testsppcomplete.c (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/teststruct.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testsubclass.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testsubclass.hh (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testtemplates.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testtypedefs.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testusing.cpp (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testusing.hh (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testvarnames.c (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testvarnames.java (100%) rename test/{manual/cedet/tests => lisp/cedet/semantic-utest-ia-resources}/testwisent.wy (100%) diff --git a/test/manual/cedet/tests/test.mk b/test/lisp/cedet/semantic-utest-ia-resources/test.mk similarity index 100% rename from test/manual/cedet/tests/test.mk rename to test/lisp/cedet/semantic-utest-ia-resources/test.mk diff --git a/test/manual/cedet/tests/test.srt b/test/lisp/cedet/semantic-utest-ia-resources/test.srt similarity index 100% rename from test/manual/cedet/tests/test.srt rename to test/lisp/cedet/semantic-utest-ia-resources/test.srt diff --git a/test/manual/cedet/tests/test.texi b/test/lisp/cedet/semantic-utest-ia-resources/test.texi similarity index 100% rename from test/manual/cedet/tests/test.texi rename to test/lisp/cedet/semantic-utest-ia-resources/test.texi diff --git a/test/manual/cedet/tests/testdoublens.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp similarity index 100% rename from test/manual/cedet/tests/testdoublens.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp diff --git a/test/manual/cedet/tests/testdoublens.hpp b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp similarity index 100% rename from test/manual/cedet/tests/testdoublens.hpp rename to test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp diff --git a/test/manual/cedet/tests/testfriends.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp similarity index 99% rename from test/manual/cedet/tests/testfriends.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp index 20425f93afa..f84ed5a2190 100644 --- a/test/manual/cedet/tests/testfriends.cpp +++ b/test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp @@ -35,4 +35,3 @@ int B::testB() { int B::testAB() { // %1% ( ( "testfriends.cpp" ) ( "B" "B::testAB" ) ) } - diff --git a/test/manual/cedet/tests/testjavacomp.java b/test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java similarity index 100% rename from test/manual/cedet/tests/testjavacomp.java rename to test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java diff --git a/test/manual/cedet/tests/testlocalvars.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp similarity index 100% rename from test/manual/cedet/tests/testlocalvars.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp diff --git a/test/manual/cedet/tests/testnsp.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp similarity index 100% rename from test/manual/cedet/tests/testnsp.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp diff --git a/test/manual/cedet/tests/testsppcomplete.c b/test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c similarity index 100% rename from test/manual/cedet/tests/testsppcomplete.c rename to test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c diff --git a/test/manual/cedet/tests/teststruct.cpp b/test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp similarity index 100% rename from test/manual/cedet/tests/teststruct.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp diff --git a/test/manual/cedet/tests/testsubclass.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp similarity index 100% rename from test/manual/cedet/tests/testsubclass.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp diff --git a/test/manual/cedet/tests/testsubclass.hh b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh similarity index 100% rename from test/manual/cedet/tests/testsubclass.hh rename to test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh diff --git a/test/manual/cedet/tests/testtemplates.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp similarity index 100% rename from test/manual/cedet/tests/testtemplates.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp diff --git a/test/manual/cedet/tests/testtypedefs.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp similarity index 100% rename from test/manual/cedet/tests/testtypedefs.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp diff --git a/test/manual/cedet/tests/testusing.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp similarity index 100% rename from test/manual/cedet/tests/testusing.cpp rename to test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp diff --git a/test/manual/cedet/tests/testusing.hh b/test/lisp/cedet/semantic-utest-ia-resources/testusing.hh similarity index 100% rename from test/manual/cedet/tests/testusing.hh rename to test/lisp/cedet/semantic-utest-ia-resources/testusing.hh diff --git a/test/manual/cedet/tests/testvarnames.c b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c similarity index 100% rename from test/manual/cedet/tests/testvarnames.c rename to test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c diff --git a/test/manual/cedet/tests/testvarnames.java b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java similarity index 100% rename from test/manual/cedet/tests/testvarnames.java rename to test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java diff --git a/test/manual/cedet/tests/testwisent.wy b/test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy similarity index 100% rename from test/manual/cedet/tests/testwisent.wy rename to test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy diff --git a/test/lisp/cedet/semantic-utest-ia.el b/test/lisp/cedet/semantic-utest-ia.el index 7210f66b0a7..122c431d472 100644 --- a/test/lisp/cedet/semantic-utest-ia.el +++ b/test/lisp/cedet/semantic-utest-ia.el @@ -30,121 +30,94 @@ ;; (Replace // with contents of comment-start for the language being tested.) ;;; Code: +(require 'ert) +(require 'ert-x) (require 'semantic) (require 'semantic/analyze) (require 'semantic/analyze/refs) (require 'semantic/symref) (require 'semantic/symref/filter) -(defvar cedet-utest-directory - (let* ((C (file-name-directory (locate-library "cedet"))) - (D (expand-file-name "../../test/manual/cedet/" C))) - D) - "Location of test files for this test suite.") - -(defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory) - "Location of test files.") - (ert-deftest semantic-utest-ia-doublens.cpp () - (let ((tst (expand-file-name "testdoublens.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testdoublens.cpp"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-subclass.cpp () - (let ((tst (expand-file-name "testsubclass.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testsubclass.cpp"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-typedefs.cpp () - (let ((tst (expand-file-name "testtypedefs.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testtypedefs.cpp"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-struct.cpp () - (let ((tst (expand-file-name "teststruct.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "teststruct.cpp"))) (should-not (semantic-ia-utest tst)))) ;;(ert-deftest semantic-utest-ia-union.cpp () -;; (let ((tst (expand-file-name "testunion.cpp" semantic-utest-test-directory))) -;; (should (file-exists-p tst)) +;; (let ((tst (ert-resource-file "testunion.cpp"))) ;; (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-templates.cpp () - (let ((tst (expand-file-name "testtemplates.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testtemplates.cpp"))) (should-not (semantic-ia-utest tst)))) ;;(ert-deftest semantic-utest-ia-friends.cpp () -;; (let ((tst (expand-file-name "testfriends.cpp" semantic-utest-test-directory))) -;; (should (file-exists-p tst)) +;; (let ((tst (ert-resource-file "testfriends.cpp"))) ;; (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-using.cpp () - (let ((tst (expand-file-name "testusing.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testusing.cpp"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-nsp.cpp () (skip-unless (executable-find "g++")) - (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testnsp.cpp"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-localvars.cpp () - (let ((tst (expand-file-name "testlocalvars.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testlocalvars.cpp"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-namespace.cpp () (skip-unless (executable-find "g++")) - (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testnsp.cpp"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-sppcomplete.c () - (let ((tst (expand-file-name "testsppcomplete.c" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testsppcomplete.c"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-varnames.c () - (let ((tst (expand-file-name "testvarnames.c" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testvarnames.c"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-javacomp.java () - (let ((tst (expand-file-name "testjavacomp.java" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testjavacomp.java"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-varnames.java () - (let ((tst (expand-file-name "testvarnames.java" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testvarnames.java"))) (should-not (semantic-ia-utest tst)))) ;;(ert-deftest semantic-utest-ia-f90.f90 () -;; (let ((tst (expand-file-name "testf90.f90" semantic-utest-test-directory))) -;; (should (file-exists-p tst)) +;; (let ((tst (ert-resource-file "testf90.f90"))) ;; (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-wisent.wy () - (let ((tst (expand-file-name "testwisent.wy" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "testwisent.wy"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-texi () - (let ((tst (expand-file-name "test.texi" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "test.texi"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-make () - (let ((tst (expand-file-name "test.mk" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "test.mk"))) (should-not (semantic-ia-utest tst)))) (ert-deftest semantic-utest-ia-srecoder () - (let ((tst (expand-file-name "test.srt" semantic-utest-test-directory))) - (should (file-exists-p tst)) + (let ((tst (ert-resource-file "test.srt"))) (should-not (semantic-ia-utest tst)))) ;;; Core testing utility From 30f3b9f8472acc53ca5948797a342cafd4ea9cd8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 13:21:34 +0100 Subject: [PATCH 100/297] * lisp/cedet/semantic/bovine/gcc.el: Use lexical-binding. --- lisp/cedet/semantic/bovine/gcc.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 1cfe5a3bac1..9cd9cdcb84b 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser +;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -25,6 +25,7 @@ ;; GCC, and set up the preprocessor and include paths. (require 'semantic/dep) +(require 'cl-lib) (defvar semantic-lex-c-preprocessor-symbol-file) (defvar semantic-lex-c-preprocessor-symbol-map) @@ -88,9 +89,7 @@ to give to the program." (let ((path (substring line 1))) (when (and (file-accessible-directory-p path) (file-name-absolute-p path)) - (add-to-list 'inc-path - (expand-file-name path) - t)))))))) + (cl-pushnew (expand-file-name path) inc-path)))))))) inc-path)) @@ -101,7 +100,7 @@ to give to the program." (dolist (L lines) (let ((dat (split-string L))) (when (= (length dat) 3) - (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat)))))) + (push (cons (nth 1 dat) (nth 2 dat)) lst)))) lst)) (defun semantic-gcc-fields (str) @@ -142,6 +141,8 @@ This is an alist, and should include keys of: `--prefix' - where GCC was installed. It should also include other symbols GCC was compiled with.") +(defvar c++-include-path) + ;;;###autoload (defun semantic-gcc-setup () "Setup Semantic C/C++ parsing based on GCC output." From d0826e592ae40d05217e69f28bbf2d1dfe4b9085 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Wed, 10 Feb 2021 06:03:33 +0200 Subject: [PATCH 101/297] Update NEWS entry for vc-dir faces * NEWS: Remove reference to specific backend, as it now applies to all of them. Update name of 'vc-dir-status-ignored'. This follows from the discussion in bug#46358. --- etc/NEWS | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index bd209de18e6..3cbf2a0fe7c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -602,10 +602,11 @@ This is used when expanding commit messages from 'vc-print-root-log' and similar commands. --- -*** New faces for 'vc-dir' buffers and their Git VC backend. +*** New faces for 'vc-dir' buffers. Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory', 'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning', -'vc-dir-status-edited', 'vc-dir-status-up-to-date', 'vc-dir-ignored'. +'vc-dir-status-edited', 'vc-dir-status-up-to-date', +'vc-dir-status-ignored'. --- *** The responsible VC backend is now the most specific one. From 70d562b43e0db4e76fbf51f30ec2f51290f525d1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 13:59:09 +0100 Subject: [PATCH 102/297] Declare empty macro imenu-progress-menu obsolete * lisp/imenu.el: Remove commented out code. (imenu-progress-message): Declare macro obsolete. * lisp/erc/erc-imenu.el (erc-create-imenu-index): * lisp/net/snmp-mode.el (snmp-mode-imenu-create-index): * lisp/progmodes/antlr-mode.el (antlr-imenu-create-index-function): Don't use or mention above obsolete macro. --- lisp/erc/erc-imenu.el | 2 -- lisp/imenu.el | 31 ++----------------------------- lisp/net/snmp-mode.el | 5 +---- lisp/progmodes/antlr-mode.el | 5 ++--- 4 files changed, 5 insertions(+), 38 deletions(-) diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 1a2d8e2755f..ecdfc2a04b5 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -73,13 +73,11 @@ Don't rely on this function, read it first!" (topic-change-alist '()) prev-pos) (goto-char (point-max)) - (imenu-progress-message prev-pos 0) (while (if (bolp) (> (forward-line -1) -1) (progn (forward-line 0) t)) - (imenu-progress-message prev-pos nil t) (save-match-data (when (looking-at (concat (regexp-quote erc-notice-prefix) "\\(.+\\)$")) diff --git a/lisp/imenu.el b/lisp/imenu.el index 2a557e04536..72d1c40e9a8 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -151,18 +151,6 @@ element should come before the second. The arguments are cons cells; :type 'integer :group 'imenu) -;; No longer used. KFS 2004-10-27 -;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)" -;; "Progress message during the index scanning of the buffer. -;; If non-nil, user gets a message during the scanning of the buffer. -;; -;; Relevant only if the mode-specific function that creates the buffer -;; index use `imenu-progress-message', and not useful if that is fast, in -;; which case you might as well set this to nil." -;; :type '(choice string -;; (const :tag "None" nil)) -;; :group 'imenu) - (defcustom imenu-space-replacement "." "The replacement string for spaces in index names. Used when presenting the index in a completion buffer to make the @@ -280,26 +268,11 @@ The function in this variable is called when selecting a normal index-item.") (not (functionp (cadr item))))) (defmacro imenu-progress-message (_prevpos &optional _relpos _reverse) - "Macro to display a progress message. -RELPOS is the relative position to display. -If RELPOS is nil, then the relative position in the buffer -is calculated. -PREVPOS is the variable in which we store the last position displayed." - + "This macro is obsolete and does nothing." + (declare (obsolete nil "28.1")) ;; Made obsolete/empty, as computers are now faster than the eye, and ;; it had problems updating the messages correctly, and could shadow ;; more important messages/prompts in the minibuffer. KFS 2004-10-27. - -;; `(and -;; imenu-scanning-message -;; (let ((pos ,(if relpos -;; relpos -;; `(imenu--relative-position ,reverse)))) -;; (if ,(if relpos t -;; `(> pos (+ 5 ,prevpos))) -;; (progn -;; (message imenu-scanning-message pos) -;; (setq ,prevpos pos))))) ) diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index 983e6d92ee0..2fbe744401d 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -474,13 +474,11 @@ lines for the purposes of this function." (index-table-alist '()) (index-trap-alist '()) (case-fold-search nil) ; keywords must be uppercase - prev-pos token end) + token end) (goto-char (point-min)) - (imenu-progress-message prev-pos 0) ;; Search for a useful MIB item (that's not in a comment) (save-match-data (while (re-search-forward snmp-clause-regexp nil t) - (imenu-progress-message prev-pos) (setq end (match-end 0) token (cons (match-string 1) @@ -498,7 +496,6 @@ lines for the purposes of this function." (push token index-tc-alist))) (goto-char end))) ;; Create the menu - (imenu-progress-message prev-pos 100) (setq index-alist (nreverse index-alist)) (and index-tc-alist (push (cons "Textual Conventions" (nreverse index-tc-alist)) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index e5b9ac0a537..d92c8c35b1b 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1246,9 +1246,8 @@ IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names." (let ((items nil) (classes nil) (continue t)) - ;; Using `imenu-progress-message' would require imenu for compilation, but - ;; nobody is missing these messages. The generic imenu function searches - ;; backward, which is slower and more likely not to work during editing. + ;; The generic imenu function searches backward, which is slower + ;; and more likely not to work during editing. (antlr-with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (goto-char (point-min)) From 553613e7ca5ff5d6120212360e166f7e45ef62d6 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 14:08:01 +0100 Subject: [PATCH 103/297] Use lexical-binding in snmp-mode.el * lisp/net/snmp-mode.el: Use lexical-binding. Remove redundant :group args. Doc fix; remove outdated information. (snmp-mode, snmpv2-mode): Add FIXME to use define-derived-mode. --- lisp/net/snmp-mode.el | 39 ++++++++++++--------------------------- 1 file changed, 12 insertions(+), 27 deletions(-) diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index 2fbe744401d..ae878ef3a51 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -1,4 +1,4 @@ -;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode +;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode -*- lexical-binding: t -*- ;; Copyright (C) 1995, 1998, 2001-2021 Free Software Foundation, Inc. @@ -69,16 +69,6 @@ ;; Once the template is done, you can use C-cC-f and C-cC-b to move back ;; and forth between the Tempo sequence points to fill in the rest of ;; the information. -;; -;; Font Lock -;; ------------ -;; -;; If you want font-lock in your MIB buffers, add this: -;; -;; (add-hook 'snmp-common-mode-hook 'turn-on-font-lock) -;; -;; Enabling global-font-lock-mode is also sufficient. -;; ;;; Code: @@ -101,42 +91,35 @@ (defcustom snmp-special-indent t "If non-nil, use a simple heuristic to try to guess the right indentation. If nil, then no special indentation is attempted." - :type 'boolean - :group 'snmp) + :type 'boolean) (defcustom snmp-indent-level 4 "Indentation level for SNMP MIBs." - :type 'integer - :group 'snmp) + :type 'integer) (defcustom snmp-tab-always-indent nil "Non-nil means TAB should always reindent the current line. A value of nil means reindent if point is within the initial line indentation; otherwise insert a TAB." - :type 'boolean - :group 'snmp) + :type 'boolean) (defcustom snmp-completion-ignore-case t "Non-nil means that case differences are ignored during completion. A value of nil means that case is significant. This is used during Tempo template completion." - :type 'boolean - :group 'snmp) + :type 'boolean) (defcustom snmp-common-mode-hook nil "Hook(s) evaluated when a buffer enters either SNMP or SNMPv2 mode." - :type 'hook - :group 'snmp) + :type 'hook) (defcustom snmp-mode-hook nil "Hook(s) evaluated when a buffer enters SNMP mode." - :type 'hook - :group 'snmp) + :type 'hook) (defcustom snmpv2-mode-hook nil "Hook(s) evaluated when a buffer enters SNMPv2 mode." - :type 'hook - :group 'snmp) + :type 'hook) (defvar snmp-tempo-tags nil "Tempo tags for SNMP mode.") @@ -291,7 +274,7 @@ This is used during Tempo template completion." ;; Set up the stuff that's common between snmp-mode and snmpv2-mode ;; -(defun snmp-common-mode (name mode abbrev font-keywords imenu-index tempo-tags) +(defun snmp-common-mode (name mode abbrev font-keywords imenu-index mode-tempo-tags) (kill-all-local-variables) ;; Become the current major mode @@ -326,7 +309,7 @@ This is used during Tempo template completion." (setq-local imenu-create-index-function imenu-index) ;; Tempo - (tempo-use-tag-list tempo-tags) + (tempo-use-tag-list mode-tempo-tags) (setq-local tempo-match-finder "\\b\\(.+\\)\\=") (setq-local tempo-interactive t) @@ -338,6 +321,7 @@ This is used during Tempo template completion." ;; ;;;###autoload (defun snmp-mode () + ;; FIXME: Use define-derived-mode. "Major mode for editing SNMP MIBs. Expression and list commands understand all C brackets. Tab indents for C code. @@ -370,6 +354,7 @@ Turning on snmp-mode runs the hooks in `snmp-common-mode-hook', then ;;;###autoload (defun snmpv2-mode () + ;; FIXME: Use define-derived-mode. "Major mode for editing SNMPv2 MIBs. Expression and list commands understand all C brackets. Tab indents for C code. From d9af4167019c4ed4f8605965cdf3e3ff7b72244f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 14:10:10 +0100 Subject: [PATCH 104/297] Minor cleanup in imenu.el * lisp/imenu.el: Doc fix; these examples have been removed. Remove redundant :group args. --- lisp/imenu.el | 39 +++++++++------------------------------ 1 file changed, 9 insertions(+), 30 deletions(-) diff --git a/lisp/imenu.el b/lisp/imenu.el index 72d1c40e9a8..7fc57c10526 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -36,14 +36,6 @@ ;; A mode-specific function is called to generate the index. It is ;; then presented to the user, who can choose from this index. -;; -;; The package comes with a set of example functions for how to -;; utilize this package. - -;; There are *examples* for index gathering functions/regular -;; expressions for C/C++ and Lisp/Emacs Lisp but it is easy to -;; customize for other modes. A function for jumping to the chosen -;; index position is also supplied. ;;; History: ;; Thanks go to @@ -81,25 +73,20 @@ Setting this to nil makes Imenu work a little faster but editing the buffer will make the generated index positions wrong. This might not yet be honored by all index-building functions." - :type 'boolean - :group 'imenu) - + :type 'boolean) (defcustom imenu-max-item-length 60 "If a number, truncate Imenu entries to that length." :type '(choice integer - (const :tag "Unlimited")) - :group 'imenu) + (const :tag "Unlimited"))) (defcustom imenu-auto-rescan nil "Non-nil means Imenu should always rescan the buffers." - :type 'boolean - :group 'imenu) + :type 'boolean) (defcustom imenu-auto-rescan-maxout 600000 "Imenu auto-rescan is disabled in buffers larger than this size (in bytes)." :type 'integer - :group 'imenu :version "26.2") (defcustom imenu-use-popup-menu 'on-mouse @@ -109,13 +96,11 @@ If t, always use a popup menu, If `on-mouse' use a popup menu when `imenu' was invoked with the mouse." :type '(choice (const :tag "On Mouse" on-mouse) (const :tag "Never" nil) - (other :tag "Always" t)) - :group 'imenu) + (other :tag "Always" t))) (defcustom imenu-eager-completion-buffer t "If non-nil, eagerly popup the completion buffer." :type 'boolean - :group 'imenu :version "22.1") (defcustom imenu-after-jump-hook nil @@ -123,8 +108,7 @@ If `on-mouse' use a popup menu when `imenu' was invoked with the mouse." Useful things to use here include `reposition-window', `recenter', and \(lambda () (recenter 0)) to show at top of screen." - :type 'hook - :group 'imenu) + :type 'hook) ;;;###autoload (defcustom imenu-sort-function nil @@ -143,27 +127,23 @@ element should come before the second. The arguments are cons cells; \(NAME . POSITION). Look at `imenu--sort-by-name' for an example." :type '(choice (const :tag "No sorting" nil) (const :tag "Sort by name" imenu--sort-by-name) - (function :tag "Another function")) - :group 'imenu) + (function :tag "Another function"))) (defcustom imenu-max-items 25 "Maximum number of elements in a mouse menu for Imenu." - :type 'integer - :group 'imenu) + :type 'integer) (defcustom imenu-space-replacement "." "The replacement string for spaces in index names. Used when presenting the index in a completion buffer to make the names work as tokens." - :type '(choice string (const nil)) - :group 'imenu) + :type '(choice string (const nil))) (defcustom imenu-level-separator ":" "The separator between index names of different levels. Used for making mouse-menu titles and for flattening nested indexes with name concatenation." - :type 'string - :group 'imenu) + :type 'string) (defcustom imenu-generic-skip-comments-and-strings t "When non-nil, ignore text inside comments and strings. @@ -171,7 +151,6 @@ Only affects `imenu-default-create-index-function' (and any alternative implementation of `imenu-create-index-function' that uses `imenu--generic-function')." :type 'boolean - :group 'imenu :version "24.4") ;;;###autoload From f3ae26cb2ae581a84bbaa15a47e9917a799a5682 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 10 Feb 2021 14:26:49 +0100 Subject: [PATCH 105/297] Fix local defvar scoping error (bug#46387) This bug was introduced by the lexical variable constant propagation mechanism. It was discovered by Michael Heerdegen. * lisp/emacs-lisp/byte-opt.el (byte-optimize-let-form) (byte-optimize-body): Let the effects of a local defvar declaration be scoped by let and let*, not any arbitrary Lisp expression body (such as progn). * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--get-vars) (bytecomp-local-defvar): New test. --- lisp/emacs-lisp/byte-opt.el | 4 ++-- test/lisp/emacs-lisp/bytecomp-tests.el | 31 ++++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4fa2c75a889..8851f0ef32d 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -698,7 +698,8 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (append new-lexvars byte-optimize--lexvars)) ;; Walk the body expressions, which may mutate some of the records, ;; and generate new bindings that exclude unused variables. - (let* ((opt-body (byte-optimize-body (cdr form) for-effect)) + (let* ((byte-optimize--dynamic-vars byte-optimize--dynamic-vars) + (opt-body (byte-optimize-body (cdr form) for-effect)) (bindings nil)) (dolist (var let-vars) ;; VAR is (NAME EXPR [KEEP [VALUE]]) @@ -730,7 +731,6 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; all-for-effect is true. returns a new list of forms. (let ((rest forms) (result nil) - (byte-optimize--dynamic-vars byte-optimize--dynamic-vars) fe new) (while rest (setq fe (or all-for-effect (cdr rest))) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index bc623d3efca..0b70c11b298 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1168,6 +1168,37 @@ mountpoint (Bug#44631)." (with-demoted-errors "Error cleaning up directory: %s" (delete-directory directory :recursive))))) +(defun bytecomp-tests--get-vars () + (list (ignore-errors (symbol-value 'bytecomp-tests--var1)) + (ignore-errors (symbol-value 'bytecomp-tests--var2)))) + +(ert-deftest bytecomp-local-defvar () + "Check that local `defvar' declarations work correctly, both +interpreted and compiled." + (let ((lexical-binding t)) + (let ((fun '(lambda () + (defvar bytecomp-tests--var1) + (let ((bytecomp-tests--var1 'a) ; dynamic + (bytecomp-tests--var2 'b)) ; still lexical + (ignore bytecomp-tests--var2) ; avoid warning + (bytecomp-tests--get-vars))))) + (should (listp fun)) ; Guard against overzealous refactoring! + (should (equal (funcall (eval fun t)) '(a nil))) + (should (equal (funcall (byte-compile fun)) '(a nil))) + ) + + ;; `progn' does not constitute a lexical scope for `defvar' (bug#46387). + (let ((fun '(lambda () + (progn + (defvar bytecomp-tests--var1) + (defvar bytecomp-tests--var2)) + (let ((bytecomp-tests--var1 'c) + (bytecomp-tests--var2 'd)) + (bytecomp-tests--get-vars))))) + (should (listp fun)) + (should (equal (funcall (eval fun t)) '(c d))) + (should (equal (funcall (byte-compile fun)) '(c d)))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: From 9b0d76e93b1e72425f8ee67de5eea74520beb5dd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 10 Feb 2021 18:10:17 +0200 Subject: [PATCH 106/297] Bump FACE_CACHE_BUCKETS_SIZE to 1009 * src/xfaces.c (FACE_CACHE_BUCKETS_SIZE): Make it 1009, a prime number, per the comment. Reported by Win Treese . --- src/xfaces.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xfaces.c b/src/xfaces.c index 12087138e51..4b020001c31 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -289,7 +289,7 @@ along with GNU Emacs. If not, see . */ /* Size of hash table of realized faces in face caches (should be a prime number). */ -#define FACE_CACHE_BUCKETS_SIZE 1001 +#define FACE_CACHE_BUCKETS_SIZE 1009 char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg"; From d6eddf2c079280e5ceea8c5251613ba801f3e54d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Feb 2021 12:36:36 -0500 Subject: [PATCH 107/297] * list/emacs-lisp/edebug.el: Don't overload `edebug-form-spec` The `edebug-form-spec` symbol property was used to store two different things: the handlers for spec elements like `body` and the handlers for spec operators like `&or`. But these two sets use different calling conventions, so they're fundamentally incompatible. So, move the handlers to spec operators to the new property `edebug--spec-op-function`. This unbreaks Edebugging of: (cl-flet ((f (&rest x) x)) 3) * lisp/emacs-lisp/edebug.el : Split the alist of built in spec elements into normal spec element and spec ops. (edebug--get-spec-op): New function. (edebug-match-specs): Use it. (edebug-match-:name): Rename from `edebug-match-colon-name`. --- lisp/emacs-lisp/edebug.el | 41 ++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 41768f26708..176f61402a8 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1687,10 +1687,10 @@ contains a circular object." (first-char (and (symbolp spec) (aref (symbol-name spec) 0))) (match (cond ((eq ?& first-char);; "&" symbols take all following specs. - (funcall (get-edebug-spec spec) cursor (cdr specs))) + (funcall (edebug--get-spec-op spec) cursor (cdr specs))) ((eq ?: first-char);; ":" symbols take one following spec. (setq rest (cdr (cdr specs))) - (funcall (get-edebug-spec spec) cursor (car (cdr specs)))) + (funcall (edebug--get-spec-op spec) cursor (car (cdr specs)))) (t;; Any other normal spec. (setq rest (cdr specs)) (edebug-match-one-spec cursor spec))))) @@ -1721,16 +1721,10 @@ contains a circular object." ;; user may want to define macros or functions with the same names. ;; We could use an internal obarray for these primitive specs. -(dolist (pair '((&optional . edebug-match-&optional) - (&rest . edebug-match-&rest) - (&or . edebug-match-&or) - (form . edebug-match-form) +(dolist (pair '((form . edebug-match-form) (sexp . edebug-match-sexp) (body . edebug-match-body) - (&define . edebug-match-&define) (name . edebug-match-name) - (:name . edebug-match-colon-name) - (:unique . edebug-match-:unique) (arg . edebug-match-arg) (def-body . edebug-match-def-body) (def-form . edebug-match-def-form) @@ -1743,15 +1737,36 @@ contains a circular object." (cl-macrolet-expr . edebug-match-cl-macrolet-expr) (cl-macrolet-name . edebug-match-cl-macrolet-name) (cl-macrolet-body . edebug-match-cl-macrolet-body) - (¬ . edebug-match-¬) - (&key . edebug-match-&key) - (&error . edebug-match-&error) (place . edebug-match-place) (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. )) (put (car pair) 'edebug-form-spec (cdr pair))) +;; Spec operators are things like `&or' and `&define': they are not +;; themselves specs matching sexps but rather ways to combine specs. +;; Contrary to spec matchers (which take 1 arg), they take 2 arguments. +;; Their name can either start with `&' or `:' and they are called +;; differently depending on this difference (The ones whose name +;; starts with `:' only handle&receive the subsequent element, +;; whereas the ones whose name starts with `&' handle&receive +;; everything that follows). +(dolist (pair '((&optional . edebug-match-&optional) + (&rest . edebug-match-&rest) + (&or . edebug-match-&or) + (&define . edebug-match-&define) + (¬ . edebug-match-¬) + (&key . edebug-match-&key) + (&error . edebug-match-&error) + (:name . edebug-match-:name) + (:unique . edebug-match-:unique) + )) + (put (car pair) 'edebug--spec-op-function (cdr pair))) + +(defun edebug--get-spec-op (name) + "Return the function that handles the spec operator NAME." + (get name 'edebug--spec-op-function)) + (defun edebug-match-symbol (cursor symbol) ;; Match a symbol spec. (let* ((spec (get-edebug-spec symbol))) @@ -2034,7 +2049,7 @@ contains a circular object." (edebug-move-cursor cursor) (list name))) -(defun edebug-match-colon-name (_cursor spec) +(defun edebug-match-:name (_cursor spec) ;; Set the edebug-def-name to the spec. (setq edebug-def-name (if edebug-def-name From 8147bf5812ea6f7fa281df4a2628efb85e3476b5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 17:31:17 +0100 Subject: [PATCH 108/297] Use lexical-binding in mail-utils.el and add tests * lisp/mail/mail-utils.el: Use lexical-binding. * test/lisp/mail/mail-utils-tests.el: New file. --- lisp/mail/mail-utils.el | 4 +- test/lisp/mail/mail-utils-tests.el | 104 +++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+), 1 deletion(-) create mode 100644 test/lisp/mail/mail-utils-tests.el diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index ad2dee59c7c..83125a0d200 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -1,4 +1,4 @@ -;;; mail-utils.el --- utility functions used both by rmail and rnews +;;; mail-utils.el --- utility functions used both by rmail and rnews -*- lexical-binding: t -*- ;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc. @@ -46,6 +46,7 @@ also the To field, unless this would leave an empty To field." :type '(choice regexp (const :tag "Your Name" nil)) :group 'mail) +(defvar epa-inhibit) ;; Returns t if file FILE is an Rmail file. ;;;###autoload (defun mail-file-babyl-p (file) @@ -58,6 +59,7 @@ also the To field, unless this would leave an empty To field." (defun mail-string-delete (string start end) "Return a string containing all of STRING except the part from START (inclusive) to END (exclusive)." + ;; FIXME: This is not used anywhere. Make obsolete? (if (null end) (substring string 0 start) (concat (substring string 0 start) (substring string end nil)))) diff --git a/test/lisp/mail/mail-utils-tests.el b/test/lisp/mail/mail-utils-tests.el new file mode 100644 index 00000000000..5b54f2440c7 --- /dev/null +++ b/test/lisp/mail/mail-utils-tests.el @@ -0,0 +1,104 @@ +;;; mail-utils-tests.el --- tests for mail-utils.el -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Stefan Kangas + +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'sasl) +(require 'mail-utils) + +(ert-deftest mail-utils-tests-mail-quote-printable () + (should (equal (mail-quote-printable "abc") "abc")) + (should (equal (mail-quote-printable "åäö") "=E5=E4=F6")) + (should (equal (mail-quote-printable "åäö" t) "=?ISO-8859-1?Q?=E5=E4=F6?="))) + +(ert-deftest mail-utils-tests-mail-quote-printable-region () + (with-temp-buffer + (insert "?=\"\"") + (mail-quote-printable-region (point-min) (point-max)) + (should (equal (buffer-string) "=3F=3D=22=22"))) + (with-temp-buffer + (insert "x") + (mail-quote-printable-region (point-min) (point-max) t) + (should (equal (buffer-string) "=?=?ISO-8859-1?Q?x")))) + +(ert-deftest mail-utils-tests-mail-unquote-printable () + (should (equal (mail-unquote-printable "=E5=E4=F6") "åäö")) + (should (equal (mail-unquote-printable "=?ISO-8859-1?Q?=E5=E4=F6?=" t) "åäö"))) + +(ert-deftest mail-utils-tests-mail-unquote-printable-region () + (with-temp-buffer + (insert "=E5=E4=F6") + (mail-unquote-printable-region (point-min) (point-max)) + (should (equal (buffer-string) "åäö"))) + (with-temp-buffer + (insert "=?ISO-8859-1?Q?=E5=E4=F6?=") + (mail-unquote-printable-region (point-min) (point-max) t) + (should (equal (buffer-string) "åäö")))) + +(ert-deftest mail-utils-tests-mail-strip-quoted-names () + (should (equal (mail-strip-quoted-names + "\"foo\" , bar@example.org") + "foo@example.org, bar@example.org"))) + +(ert-deftest mail-utils-tests-mail-dont-reply-to () + (let ((mail-dont-reply-to-names "foo@example.org")) + (should (equal (mail-dont-reply-to "foo@example.org, bar@example.org") + "bar@example.org")))) + + +(ert-deftest mail-utils-tests-mail-fetch-field () + (with-temp-buffer + (insert "Foo: bar\nBaz: zut") + (should (equal (mail-fetch-field "Foo") "bar")))) + +(ert-deftest mail-utils-tests-mail-parse-comma-list () + (with-temp-buffer + (insert "foo@example.org,bar@example.org,baz@example.org") + (goto-char (point-min)) + (should (equal (mail-parse-comma-list) + '("baz@example.org" "bar@example.org" "foo@example.org"))))) + +(ert-deftest mail-utils-tests-mail-comma-list-regexp () + (should (equal (mail-comma-list-regexp + "foo@example.org,bar@example.org,baz@example.org") + "foo@example.org\\|bar@example.org\\|baz@example.org"))) + +(ert-deftest mail-utils-tests-mail-rfc822-time-zone () + (should (stringp (mail-rfc822-time-zone (current-time))))) + +(ert-deftest mail-utils-test-mail-rfc822-date/contains-year () + (should (string-match (rx " 20" digit digit " ") + (mail-rfc822-date)))) + +(ert-deftest mail-utils-test-mail-mbox-from () + (with-temp-buffer + (insert "Subject: Hello +From: jrh@example.org +To: emacs-devel@gnu.org +Date: Sun, 07 Feb 2021 22:46:37 -0500") + (should (equal (mail-mbox-from) + "From jrh@example.org Sun Feb 7 22:46:37 2021\n")))) + +(provide 'mail-utils-tests) +;;; mail-utils-tests.el ends here From dcfb8f6b617f285a51e4aac23e37b0e81ae37698 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 18:42:52 +0100 Subject: [PATCH 109/297] Use lexical-binding in dns-mode.el * lisp/textmodes/dns-mode.el: Use lexical-binding. Remove redundant :group args. * test/lisp/textmodes/dns-mode-tests.el (dns-mode-tests-dns-mode-soa-increment-serial): New test. --- lisp/textmodes/dns-mode.el | 20 +++++++------------- test/lisp/textmodes/dns-mode-tests.el | 21 +++++++++++++++++++++ 2 files changed, 28 insertions(+), 13 deletions(-) diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 23a622992ad..f1a7517192f 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -1,4 +1,4 @@ -;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files +;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files -*- lexical-binding: t -*- ;; Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc. @@ -70,23 +70,19 @@ (defface dns-mode-control-entity '((t :inherit font-lock-keyword-face)) "Face used for DNS control entities, e.g. $ORIGIN." - :version "26.1" - :group 'dns-mode) + :version "26.1") (defface dns-mode-bad-control-entity '((t :inherit font-lock-warning-face)) "Face used for non-standard DNS control entities, e.g. $FOO." - :version "26.1" - :group 'dns-mode) + :version "26.1") (defface dns-mode-type '((t :inherit font-lock-type-face)) "Face used for DNS types, e.g., SOA." - :version "26.1" - :group 'dns-mode) + :version "26.1") (defface dns-mode-class '((t :inherit font-lock-constant-face)) "Face used for DNS classes, e.g., IN." - :version "26.1" - :group 'dns-mode) + :version "26.1") (defvar dns-mode-control-entity-face ''dns-mode-control-entity "Name of face used for control entities, e.g. $ORIGIN.") @@ -121,8 +117,7 @@ (,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face)) "Font lock keywords used to highlight text in DNS master file mode." :version "26.1" - :type 'sexp - :group 'dns-mode) + :type 'sexp) (defcustom dns-mode-soa-auto-increment-serial t "Whether to increment the SOA serial number automatically. @@ -134,8 +129,7 @@ manually with \\[dns-mode-soa-increment-serial]." :type '(choice (const :tag "Always" t) (const :tag "Ask" ask) (const :tag "Never" nil)) - :safe 'symbolp - :group 'dns-mode) + :safe 'symbolp) ;; Syntax table. diff --git a/test/lisp/textmodes/dns-mode-tests.el b/test/lisp/textmodes/dns-mode-tests.el index 694d683d546..92b6cc9177c 100644 --- a/test/lisp/textmodes/dns-mode-tests.el +++ b/test/lisp/textmodes/dns-mode-tests.el @@ -25,6 +25,27 @@ (require 'ert) (require 'dns-mode) +(ert-deftest dns-mode-tests-dns-mode-soa-increment-serial () + (with-temp-buffer + (insert "$TTL 86400 +@ IN SOA ns.icann.org. noc.dns.icann.org. ( + 2015080302 ;Serial + 7200 ;Refresh + 3600 ;Retry + 1209600 ;Expire + 3600 ;Negative response caching TTL\n)") + (dns-mode-soa-increment-serial) + ;; Number is updated from 2015080302 to the current date + ;; (actually, just ensure the year part is later than 2020). + (should (string-match "$TTL 86400 +@ IN SOA ns.icann.org. noc.dns.icann.org. ( + 20[2-9][0-9]+ ;Serial + 7200 ;Refresh + 3600 ;Retry + 1209600 ;Expire + 3600 ;Negative response caching TTL\n)" + (buffer-string))))) + ;;; IPv6 reverse zones (ert-deftest dns-mode-ipv6-conversion () (let ((address "2001:db8::42")) From d03f2a6ee942882c5bc78226b4730dac6f1d0916 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 10 Feb 2021 20:04:26 +0200 Subject: [PATCH 110/297] Avoid assertion violation in callproc.c * src/callproc.c (call_process): Avoid assertion violation when DESTINATION is a cons cell '(:file . "FOO")'. (Bug#46426) --- src/callproc.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/callproc.c b/src/callproc.c index 5b1d8bfb765..3eac38d375a 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -394,7 +394,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, /* If the buffer is (still) a list, it might be a (:file "file") spec. */ if (CONSP (buffer) && EQ (XCAR (buffer), QCfile)) { - output_file = Fexpand_file_name (XCAR (XCDR (buffer)), + Lisp_Object ofile = XCDR (buffer); + if (CONSP (ofile)) + ofile = XCAR (ofile); + CHECK_STRING (ofile); + output_file = Fexpand_file_name (ofile, BVAR (current_buffer, directory)); CHECK_STRING (output_file); buffer = Qnil; From 2e5d400ca6d7619cb4c0bcbd8abf5828127c77bf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Feb 2021 13:12:09 -0500 Subject: [PATCH 111/297] * lisp/emacs-lisp/edebug.el: Tweak last change Use generic functions i.s.o `edebug--spec-op-function`. : No need to register the &foo and :foo handler any more. (edebug--handle-&-spec-op, edebug--handle-:-spec-op): New generic functions. (edebug-match-specs): Use them. (edebug--get-spec-op): Remove function. (edebug-match-&optional, edebug-match-&rest, edebug-match-&or) (edebug-match-¬, edebug-match-&key, edebug-match-&error) (edebug-match-&define): Turn functions into methods of `edebug--handle-&-spec-op`. (edebug-match-:name, edebug-match-:unique): Turn functions into methods of `edebug--handle-:-spec-op`. --- lisp/emacs-lisp/edebug.el | 59 +++++++++++++++------------------------ 1 file changed, 22 insertions(+), 37 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 176f61402a8..0733dcec27b 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1687,10 +1687,10 @@ contains a circular object." (first-char (and (symbolp spec) (aref (symbol-name spec) 0))) (match (cond ((eq ?& first-char);; "&" symbols take all following specs. - (funcall (edebug--get-spec-op spec) cursor (cdr specs))) + (edebug--handle-&-spec-op spec cursor (cdr specs))) ((eq ?: first-char);; ":" symbols take one following spec. (setq rest (cdr (cdr specs))) - (funcall (edebug--get-spec-op spec) cursor (car (cdr specs)))) + (edebug--handle-:-spec-op spec cursor (car (cdr specs)))) (t;; Any other normal spec. (setq rest (cdr specs)) (edebug-match-one-spec cursor spec))))) @@ -1743,30 +1743,6 @@ contains a circular object." )) (put (car pair) 'edebug-form-spec (cdr pair))) -;; Spec operators are things like `&or' and `&define': they are not -;; themselves specs matching sexps but rather ways to combine specs. -;; Contrary to spec matchers (which take 1 arg), they take 2 arguments. -;; Their name can either start with `&' or `:' and they are called -;; differently depending on this difference (The ones whose name -;; starts with `:' only handle&receive the subsequent element, -;; whereas the ones whose name starts with `&' handle&receive -;; everything that follows). -(dolist (pair '((&optional . edebug-match-&optional) - (&rest . edebug-match-&rest) - (&or . edebug-match-&or) - (&define . edebug-match-&define) - (¬ . edebug-match-¬) - (&key . edebug-match-&key) - (&error . edebug-match-&error) - (:name . edebug-match-:name) - (:unique . edebug-match-:unique) - )) - (put (car pair) 'edebug--spec-op-function (cdr pair))) - -(defun edebug--get-spec-op (name) - "Return the function that handles the spec operator NAME." - (get name 'edebug--spec-op-function)) - (defun edebug-match-symbol (cursor symbol) ;; Match a symbol spec. (let* ((spec (get-edebug-spec symbol))) @@ -1808,7 +1784,7 @@ contains a circular object." (defsubst edebug-match-body (cursor) (edebug-forms cursor)) -(defun edebug-match-&optional (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &optional)) cursor specs) ;; Keep matching until one spec fails. (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper)) @@ -1834,7 +1810,11 @@ contains a circular object." ;; Reuse the &optional handler with this as the remainder handler. (edebug-&optional-wrapper cursor specs remainder-handler)) -(defun edebug-match-&rest (cursor specs) +(cl-defgeneric edebug--handle-&-spec-op (op cursor specs) + "Handle &foo spec operators. +&foo spec operators operate on all the subsequent SPECS.") + +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &rest)) cursor specs) ;; Repeatedly use specs until failure. (let ((edebug-&rest specs) ;; remember these edebug-best-error @@ -1842,7 +1822,7 @@ contains a circular object." (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper))) -(defun edebug-match-&or (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &or)) cursor specs) ;; Keep matching until one spec succeeds, and return its results. ;; If none match, fail. ;; This needs to be optimized since most specs spend time here. @@ -1867,23 +1847,24 @@ contains a circular object." )) -(defun edebug-match-¬ (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs) ;; If any specs match, then fail (if (null (catch 'no-match (let ((edebug-gate nil)) (save-excursion - (edebug-match-&or cursor specs))) + (edebug--handle-&-spec-op '&or cursor specs))) nil)) ;; This means something matched, so it is a no match. (edebug-no-match cursor "Unexpected")) ;; This means nothing matched, so it is OK. nil) ;; So, return nothing -(defun edebug-match-&key (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &key)) cursor specs) ;; Following specs must look like ( ) ... ;; where is the name of a keyword, and spec is its spec. ;; This really doesn't save much over the expanded form and takes time. - (edebug-match-&rest + (edebug--handle-&-spec-op + '&rest cursor (cons '&or (mapcar (lambda (pair) @@ -1891,7 +1872,7 @@ contains a circular object." (car (cdr pair)))) specs)))) -(defun edebug-match-&error (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &error)) cursor specs) ;; Signal an error, using the following string in the spec as argument. (let ((error-string (car specs)) (edebug-error-point (edebug-before-offset cursor))) @@ -1995,7 +1976,7 @@ contains a circular object." (defun edebug-match-function (_cursor) (error "Use function-form instead of function in edebug spec")) -(defun edebug-match-&define (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &define)) cursor specs) ;; Match a defining form. ;; Normally, &define is interpreted specially other places. ;; This should only be called inside of a spec list to match the remainder @@ -2049,7 +2030,11 @@ contains a circular object." (edebug-move-cursor cursor) (list name))) -(defun edebug-match-:name (_cursor spec) +(cl-defgeneric edebug--handle-:-spec-op (op cursor spec) + "Handle :foo spec operators. +:foo spec operators operate on just the one subsequent SPEC element.") + +(cl-defmethod edebug--handle-:-spec-op ((_ (eql :name)) _cursor spec) ;; Set the edebug-def-name to the spec. (setq edebug-def-name (if edebug-def-name @@ -2058,7 +2043,7 @@ contains a circular object." spec)) nil) -(defun edebug-match-:unique (_cursor spec) +(cl-defmethod edebug--handle-:-spec-op ((_ (eql :unique)) _cursor spec) "Match a `:unique PREFIX' specifier. SPEC is the symbol name prefix for `gensym'." (let ((suffix (gensym spec))) From 21e475ea0c0d04ae7634f377ed64fe179388b133 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 10 Feb 2021 19:38:10 +0100 Subject: [PATCH 112/297] Remove the 'M-o' ('facemap-keymap') binding experimentally * doc/lispref/maps.texi (Standard Keymaps): * doc/lispref/keymaps.texi (Prefix Keys): Remove mentions. * etc/facemenu-removal.txt: New temporary file. * lisp/loadup.el: Don't load facemenu.el. (removed-facemenu-command): New command. (facemenu-keymap-restore): New function. * lisp/textmodes/text-mode.el (center-paragraph): Remove binding. (center-line): Remove binding. --- doc/lispref/keymaps.texi | 6 ------ doc/lispref/maps.texi | 3 --- etc/NEWS | 5 +++++ etc/facemenu-removal.txt | 20 ++++++++++++++++++++ lisp/loadup.el | 25 ++++++++++++++++++++++--- lisp/textmodes/text-mode.el | 4 ---- 6 files changed, 47 insertions(+), 16 deletions(-) create mode 100644 etc/facemenu-removal.txt diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 55d179b8753..6a227e3a792 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -573,12 +573,6 @@ key. @code{search-map} is the global keymap used for the @kbd{M-s} prefix key. -@item -@cindex @kbd{M-o} -@vindex facemenu-keymap -@code{facemenu-keymap} is the global keymap used for the @kbd{M-o} -prefix key. - @item The other Emacs prefix keys are @kbd{C-x @@}, @kbd{C-x a i}, @kbd{C-x @key{ESC}} and @kbd{@key{ESC} @key{ESC}}. They use keymaps that have diff --git a/doc/lispref/maps.texi b/doc/lispref/maps.texi index aea02424086..59c6e6f57ad 100644 --- a/doc/lispref/maps.texi +++ b/doc/lispref/maps.texi @@ -53,9 +53,6 @@ A sparse keymap for subcommands of the prefix @kbd{C-x r}.@* @item esc-map A full keymap for @key{ESC} (or @key{Meta}) commands. -@item facemenu-keymap -A sparse keymap used for the @kbd{M-o} prefix key. - @item function-key-map The parent keymap of all @code{local-function-key-map} (q.v.@:) instances. diff --git a/etc/NEWS b/etc/NEWS index 3cbf2a0fe7c..67fc49f1817 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2048,6 +2048,11 @@ first). * Incompatible Editing Changes in Emacs 28.1 +** The 'M-o' ('facemanu-keymap') global binding has been removed. + +** The 'M-o M-s' and 'M-o M-S' global bindings have been removed. +Use 'M-x center-line' and 'M-x center-paragraph' instead. + ** In 'f90-mode', the backslash character ('\') no longer escapes. For about a decade, the backslash character has no longer had a special escape syntax in Fortran F90. To get the old behaviour back, diff --git a/etc/facemenu-removal.txt b/etc/facemenu-removal.txt new file mode 100644 index 00000000000..9a969df0e49 --- /dev/null +++ b/etc/facemenu-removal.txt @@ -0,0 +1,20 @@ +`facemenu-keymap' (normally bound to `M-o') has been disabled. +============================================================== + +We've disabled the normal `M-o' keymap for a month (until March the +10th, 2021) in the development version of Emacs to see whether anybody +uses this feature. + +If the removal of this key binding doesn't annoy too many people, the +plan is to then leave the it unbound, for usage by third-party +packages and users. + +If you wish to restore the binding during the trial period, you can +put the following in your .emacs file: + +(facemenu-keymap-restore) + +After the trial period is over, the function will be removed. + +If you wish to protest the removal of the `M-o' key binding, please +send your thoughts to the emacs-devel@gnu.org mailing list. diff --git a/lisp/loadup.el b/lisp/loadup.el index 9cee6a2fd83..3ee8bed1842 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -253,9 +253,6 @@ (load "startup") (load "term/tty-colors") (load "font-core") -;; facemenu must be loaded before font-lock, because `facemenu-keymap' -;; needs to be defined when font-lock is loaded. -(load "facemenu") (load "emacs-lisp/syntax") (load "font-lock") (load "jit-lock") @@ -477,6 +474,28 @@ lost after dumping"))) ;; Make sure we will attempt bidi reordering henceforth. (setq redisplay--inhibit-bidi nil) + +;; Experimental feature removal. +(define-key global-map "\M-o" #'removed-facemenu-command) + +(defun removed-facemenu-command () + "Transition command during test period for facemenu removal." + (interactive) + (switch-to-buffer "*Facemenu Removal*") + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-file-contents + (expand-file-name "facemenu-removal.txt" data-directory))) + (goto-char (point-min)) + (special-mode)) + +(defun facemenu-keymap-restore () + "Restore the facemenu keymap." + (require 'facemenu) + (define-key facemenu-keymap "\eS" 'center-paragraph) + (define-key facemenu-keymap "\es" 'center-line)) + + (if dump-mode (let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp") ((equal dump-mode "dump") "emacs") diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 1432ab6a300..ab9f7b9c7c0 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -169,8 +169,6 @@ both existing buffers and buffers that you subsequently create." (if enable-mode "enabled" "disabled")))) -(define-key facemenu-keymap "\eS" 'center-paragraph) - (defun center-paragraph () "Center each nonblank line in the paragraph at or after point. See `center-line' for more info." @@ -198,8 +196,6 @@ See `center-line' for more info." (center-line)) (forward-line 1))))) -(define-key facemenu-keymap "\es" 'center-line) - (defun center-line (&optional nlines) "Center the line point is on, within the width specified by `fill-column'. This means adjusting the indentation so that it equals From 4459dcc07865f6ae1f21f624fcb09cf8fdaecdb5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 10 Feb 2021 10:50:44 -0800 Subject: [PATCH 113/297] Fix file lock issue (Bug#46397) * src/filelock.c (current_lock_owner): Also treat ENOTDIR as meaning the lock file does not exist. --- src/filelock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/filelock.c b/src/filelock.c index 35baa0c6668..373fc00a42c 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -532,7 +532,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* If nonexistent lock file, all is well; otherwise, got strange error. */ lfinfolen = read_lock_data (lfname, owner->user); if (lfinfolen < 0) - return errno == ENOENT ? 0 : errno; + return errno == ENOENT || errno == ENOTDIR ? 0 : errno; if (MAX_LFINFO < lfinfolen) return ENAMETOOLONG; owner->user[lfinfolen] = 0; From 4467073c50d2c7fbbb30530d1a0a25f8272ff56f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 10 Feb 2021 10:55:42 -0800 Subject: [PATCH 114/297] Simplify and speed up after-find-file Use newer primitives like file-accessible-directory-p to simplify and speed up longstanding code in after-find-file. * lisp/files.el (after-find-file): Prefer file-exists-p + file-symlink-p to file-attributes + file-symlink-p + file-chase-links + file-exists-p. Prefer file-accessible-directory-p to directory-file-name + file-attributes. Prefer file-directory-p to file-name-directory + file-exists-p. --- lisp/files.el | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index dada69c1457..9ff8f31e374 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2530,13 +2530,11 @@ unless NOMODES is non-nil." (msg (cond ((not warn) nil) - ((and error (file-attributes buffer-file-name)) + ((and error (file-exists-p buffer-file-name)) (setq buffer-read-only t) - (if (and (file-symlink-p buffer-file-name) - (not (file-exists-p - (file-chase-links buffer-file-name)))) - "Symbolic link that points to nonexistent file" - "File exists, but cannot be read")) + "File exists, but cannot be read") + ((and error (file-symlink-p buffer-file-name)) + "Symbolic link that points to nonexistent file") ((not buffer-read-only) (if (and warn ;; No need to warn if buffer is auto-saved @@ -2553,13 +2551,12 @@ unless NOMODES is non-nil." ((not error) (setq not-serious t) "Note: file is write protected") - ((file-attributes (directory-file-name default-directory)) + ((file-accessible-directory-p default-directory) "File not found and directory write-protected") - ((file-exists-p (file-name-directory buffer-file-name)) - (setq buffer-read-only nil)) (t (setq buffer-read-only nil) - "Use M-x make-directory RET RET to create the directory and its parents")))) + (unless (file-directory-p default-directory) + "Use M-x make-directory RET RET to create the directory and its parents"))))) (when msg (message "%s" msg) (or not-serious (sit-for 1 t)))) From 81e55fa6c37d51845b50ae22a935185cd441e99b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 10 Feb 2021 20:37:10 +0100 Subject: [PATCH 115/297] Fix build problem with previous facemenu change * lisp/facemenu.el (facemenu-add-face-function): Move to avoid a warning. (list-colors-display): Autoload. --- lisp/facemenu.el | 4 ---- lisp/loadup.el | 5 ++++- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index dc5f8f46aba..6290b02add2 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -85,10 +85,6 @@ ;;; Code: -;; Global bindings: -(define-key global-map [C-down-mouse-2] 'facemenu-menu) -(define-key global-map "\M-o" 'facemenu-keymap) - (defgroup facemenu nil "Create a face menu for interactively adding fonts to text." :group 'faces diff --git a/lisp/loadup.el b/lisp/loadup.el index 3ee8bed1842..c91c00a1075 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -253,6 +253,7 @@ (load "startup") (load "term/tty-colors") (load "font-core") +(load "facemenu") (load "emacs-lisp/syntax") (load "font-lock") (load "jit-lock") @@ -491,7 +492,9 @@ lost after dumping"))) (defun facemenu-keymap-restore () "Restore the facemenu keymap." - (require 'facemenu) + ;; Global bindings: + (define-key global-map [C-down-mouse-2] 'facemenu-menu) + (define-key global-map "\M-o" 'facemenu-keymap) (define-key facemenu-keymap "\eS" 'center-paragraph) (define-key facemenu-keymap "\es" 'center-line)) From 6bfdfeed36fab4680c8db90c22da8f6611694186 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 10 Feb 2021 21:37:47 +0200 Subject: [PATCH 116/297] Fix ediff even/odd faces to increase their contrast and readability * lisp/vc/ediff-init.el (ediff-even-diff-A, ediff-even-diff-B) (ediff-even-diff-C, ediff-even-diff-Ancestor, ediff-odd-diff-A) (ediff-odd-diff-B, ediff-odd-diff-C): Add :distant-foreground "Black" for light background. For dark background add :distant-foreground "White", and use darker shades of grey for background colors (bug#46396). --- lisp/vc/ediff-init.el | 42 ++++++++++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 14 deletions(-) diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 6e658163b91..3f33e6aae2e 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -980,8 +980,10 @@ this variable represents.") (defface ediff-even-diff-A `((((type pc)) (:foreground "green3" :background "light grey" :extend t)) - (((class color) (min-colors 88)) - (:background "light grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "light grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dark grey" :extend t)) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey" :extend t)) (((class color)) @@ -999,8 +1001,10 @@ widget to customize the actual face object `ediff-even-diff-A' this variable represents.") (defface ediff-even-diff-B - `((((class color) (min-colors 88)) - (:background "Grey" :extend t)) + `((((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "Grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dim grey" :extend t)) (((class color) (min-colors 16)) (:foreground "White" :background "Grey" :extend t)) (((class color)) @@ -1019,8 +1023,10 @@ this variable represents.") (defface ediff-even-diff-C `((((type pc)) (:foreground "yellow3" :background "light grey" :extend t)) - (((class color) (min-colors 88)) - (:background "light grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "light grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dark grey" :extend t)) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey" :extend t)) (((class color)) @@ -1040,8 +1046,10 @@ this variable represents.") (defface ediff-even-diff-Ancestor `((((type pc)) (:foreground "cyan3" :background "light grey" :extend t)) - (((class color) (min-colors 88)) - (:background "Grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "Grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dim grey" :extend t)) (((class color) (min-colors 16)) (:foreground "White" :background "Grey" :extend t)) (((class color)) @@ -1068,8 +1076,10 @@ this variable represents.") (defface ediff-odd-diff-A '((((type pc)) (:foreground "green3" :background "gray40" :extend t)) - (((class color) (min-colors 88)) - (:background "Grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "Grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dim grey" :extend t)) (((class color) (min-colors 16)) (:foreground "White" :background "Grey" :extend t)) (((class color)) @@ -1088,8 +1098,10 @@ this variable represents.") (defface ediff-odd-diff-B '((((type pc)) (:foreground "White" :background "gray40" :extend t)) - (((class color) (min-colors 88)) - (:background "light grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "light grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dark grey" :extend t)) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey" :extend t)) (((class color)) @@ -1108,8 +1120,10 @@ this variable represents.") (defface ediff-odd-diff-C '((((type pc)) (:foreground "yellow3" :background "gray40" :extend t)) - (((class color) (min-colors 88)) - (:background "Grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "Grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dim grey" :extend t)) (((class color) (min-colors 16)) (:foreground "White" :background "Grey" :extend t)) (((class color)) From 29c47ac19a393d2544562fe8932bc4e1b6ddd7c9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Feb 2021 16:06:24 -0500 Subject: [PATCH 117/297] * lisp/emacs-lisp/macroexp.el (macroexp--fgrep): Break cycles * test/lisp/emacs-lisp/macroexp-tests.el: New file. --- lisp/emacs-lisp/macroexp.el | 43 +++++++++++++++++--------- test/lisp/emacs-lisp/macroexp-tests.el | 36 +++++++++++++++++++++ 2 files changed, 65 insertions(+), 14 deletions(-) create mode 100644 test/lisp/emacs-lisp/macroexp-tests.el diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 042061c44fc..13ff5ef2eda 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -572,20 +572,35 @@ test of free variables in the following ways: - For the same reason it may cause the result to fail to include bindings which will be used if SEXP is not yet fully macro-expanded and the use of the binding will only be revealed by macro expansion." - (let ((res '())) - (while (and (consp sexp) bindings) - (dolist (binding (macroexp--fgrep bindings (pop sexp))) - (push binding res) - (setq bindings (remove binding bindings)))) - (if (or (vectorp sexp) (byte-code-function-p sexp)) - ;; With backquote, code can appear within vectors as well. - ;; This wouldn't be needed if we `macroexpand-all' before - ;; calling macroexp--fgrep, OTOH. - (macroexp--fgrep bindings (mapcar #'identity sexp)) - (let ((tmp (assq sexp bindings))) - (if tmp - (cons tmp res) - res))))) + (let ((res '()) + ;; Cyclic code should not happen, but code can contain cyclic data :-( + (seen (make-hash-table :test #'eq)) + (sexpss (list (list sexp)))) + ;; Use a nested while loop to reduce the amount of heap allocations for + ;; pushes to `sexpss' and the `gethash' overhead. + (while (and sexpss bindings) + (let ((sexps (pop sexpss))) + (unless (gethash sexps seen) + (puthash sexps t seen) ;; Using `setf' here causes bootstrap problems. + (if (vectorp sexps) (setq sexps (mapcar #'identity sexps))) + (let ((tortoise sexps) (skip t)) + (while sexps + (let ((sexp (if (consp sexps) (pop sexps) + (prog1 sexps (setq sexps nil))))) + (if skip + (setq skip nil) + (setq tortoise (cdr tortoise)) + (if (eq tortoise sexps) + (setq sexps nil) ;; Found a cycle: we're done! + (setq skip t))) + (cond + ((or (consp sexp) (vectorp sexp)) (push sexp sexpss)) + (t + (let ((tmp (assq sexp bindings))) + (when tmp + (push tmp res) + (setq bindings (remove tmp bindings)))))))))))) + res)) ;;; Load-time macro-expansion. diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el new file mode 100644 index 00000000000..1124e3b8d91 --- /dev/null +++ b/test/lisp/emacs-lisp/macroexp-tests.el @@ -0,0 +1,36 @@ +;;; macroexp-tests.el --- Tests for macroexp.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Stefan Monnier + +;; Author: Stefan Monnier +;; Keywords: + +;; 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 . + +;;; Commentary: + +;; + +;;; Code: + +(ert-deftest macroexp--tests-fgrep () + (should (equal (macroexp--fgrep '((x) (y)) '([x] z ((u)))) + '((x)))) + (should (equal (macroexp--fgrep '((x) (y)) '#2=([y] ((y #2#)))) + '((y)))) + (should (equal (macroexp--fgrep '((x) (y)) '#2=([r] ((a x)) a b c d . #2#)) + '((x))))) + +(provide 'macroexp-tests) +;;; macroexp-tests.el ends here From 5a598fa41491132758810649ddbb565d44142f76 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Feb 2021 16:39:53 -0500 Subject: [PATCH 118/297] * lisp/subr.el (combine-change-calls-1): Don't presume integer args This avoids problems where the `after-change-functions` end up called with the new length rather than the old length. --- lisp/subr.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/subr.el b/lisp/subr.el index 6573090ebe3..eb287287608 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4330,6 +4330,8 @@ the specified region. It must not change Additionally, the buffer modifications of BODY are recorded on the buffer's undo list as a single (apply ...) entry containing the function `undo--wrap-and-run-primitive-undo'." + (if (markerp beg) (setq beg (marker-position beg))) + (if (markerp end) (setq end (marker-position end))) (let ((old-bul buffer-undo-list) (end-marker (copy-marker end t)) result) From 8d33cc53a2d0ce893afad77703ba361593896084 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Feb 2021 17:35:31 -0500 Subject: [PATCH 119/297] * lisp/leim/quail: Use lexical-binding * lisp/leim/quail/hangul.el: * lisp/leim/quail/indian.el: * lisp/leim/quail/ipa.el: * lisp/leim/quail/japanese.el: * lisp/leim/quail/lao.el: * lisp/leim/quail/latin-ltx.el: * lisp/leim/quail/lrt.el: * lisp/leim/quail/sisheng.el: * lisp/leim/quail/thai.el: * lisp/leim/quail/tibetan.el: Use lexical-binding. * lisp/leim/quail/uni-input.el (ucs-input-method): Remove unused var `str`. --- lisp/leim/quail/indian.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index 6f5054e3f62..2e365082738 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -1,4 +1,4 @@ -;;; indian.el --- Quail packages for inputting Indian +;;; indian.el --- Quail packages for inputting Indian -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -39,7 +39,7 @@ (defun quail-define-indian-trans-package (hashtbls pkgname lang title doc) - (funcall 'quail-define-package pkgname lang title t doc + (quail-define-package pkgname lang title t doc nil nil nil nil nil nil t nil) (maphash (lambda (key val) @@ -200,7 +200,7 @@ (setq clm 6) (dolist (v vowels) - (apply 'insert (propertize "\t" 'display (list 'space :align-to clm)) + (apply #'insert (propertize "\t" 'display (list 'space :align-to clm)) (if (nth 1 c) (list (nth 1 c) (nth 2 v)) (list ""))) (setq clm (+ clm 6)))) (insert "\n") @@ -309,7 +309,7 @@ Full key sequences are listed below:") (defun quail-define-inscript-package (char-tables key-tables pkgname lang title docstring) - (funcall 'quail-define-package pkgname lang title nil docstring + (quail-define-package pkgname lang title nil docstring nil nil nil t nil nil nil nil) (let (char-table key-table char key) (while (and char-tables key-tables) @@ -627,7 +627,7 @@ Full key sequences are listed below:") (quail-define-package "malayalam-mozhi" "Malayalam" "MlmMI" t "Malayalam transliteration by Mozhi method." nil nil t nil nil nil t nil - 'indian-mlm-mozhi-update-translation) + #'indian-mlm-mozhi-update-translation) (maphash (lambda (key val) @@ -636,9 +636,9 @@ Full key sequences are listed below:") (vector val)))) (cdr indian-mlm-mozhi-hash)) -(defun indian-mlm-mozhi-underscore (key len) (throw 'quail-tag nil)) +(defun indian-mlm-mozhi-underscore (_key _len) (throw 'quail-tag nil)) -(quail-defrule "_" 'indian-mlm-mozhi-underscore) +(quail-defrule "_" #'indian-mlm-mozhi-underscore) (quail-defrule "|" ?‌) (quail-defrule "||" ?​) From 1b4435e6ea6e7699e43f6079b111b42879fc7c47 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Feb 2021 17:37:25 -0500 Subject: [PATCH 120/297] * lisp/leim/quail: Use lexical-binding * lisp/leim/quail/hangul.el: * lisp/leim/quail/indian.el: * lisp/leim/quail/ipa.el: * lisp/leim/quail/japanese.el: * lisp/leim/quail/lao.el: * lisp/leim/quail/latin-ltx.el: * lisp/leim/quail/lrt.el: * lisp/leim/quail/sisheng.el: * lisp/leim/quail/thai.el: * lisp/leim/quail/tibetan.el: Use lexical-binding. * lisp/leim/quail/uni-input.el (ucs-input-method): Remove unused var `str`. --- lisp/leim/quail/hangul.el | 22 +++++++++++----------- lisp/leim/quail/ipa.el | 8 ++++---- lisp/leim/quail/japanese.el | 10 +++++----- lisp/leim/quail/lao.el | 4 ++-- lisp/leim/quail/latin-ltx.el | 2 +- lisp/leim/quail/lrt.el | 4 ++-- lisp/leim/quail/sisheng.el | 2 +- lisp/leim/quail/thai.el | 2 +- lisp/leim/quail/tibetan.el | 8 ++++---- lisp/leim/quail/uni-input.el | 19 ++++++++++--------- 10 files changed, 41 insertions(+), 40 deletions(-) diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el index ca1aae77be3..c03e86b33c0 100644 --- a/lisp/leim/quail/hangul.el +++ b/lisp/leim/quail/hangul.el @@ -1,4 +1,4 @@ -;;; hangul.el --- Korean Hangul input method +;;; hangul.el --- Korean Hangul input method -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -88,9 +88,9 @@ (defvar hangul-im-keymap (let ((map (make-sparse-keymap))) - (define-key map "\d" 'hangul-delete-backward-char) - (define-key map [f9] 'hangul-to-hanja-conversion) - (define-key map [Hangul_Hanja] 'hangul-to-hanja-conversion) + (define-key map "\d" #'hangul-delete-backward-char) + (define-key map [f9] #'hangul-to-hanja-conversion) + (define-key map [Hangul_Hanja] #'hangul-to-hanja-conversion) map) "Keymap for Hangul method. It is used by all Hangul input methods.") @@ -337,7 +337,7 @@ Other parts are the same as a `hangul3-input-method-cho'." char))))) (aset hangul-queue 5 char))) (hangul-insert-character hangul-queue) - (if (zerop (apply '+ (append hangul-queue nil))) + (if (zerop (apply #'+ (append hangul-queue nil))) (hangul-insert-character (setq hangul-queue (vector 0 0 0 0 char 0))) (hangul-insert-character hangul-queue (setq hangul-queue (vector 0 0 0 0 char 0)))))) @@ -349,7 +349,7 @@ Other parts are the same as a `hangul3-input-method-cho'." (while (and (> i 0) (zerop (aref hangul-queue i))) (setq i (1- i))) (aset hangul-queue i 0)) - (if (notzerop (apply '+ (append hangul-queue nil))) + (if (notzerop (apply #'+ (append hangul-queue nil))) (hangul-insert-character hangul-queue) (delete-char -1))) @@ -514,16 +514,16 @@ When a Korean input method is off, convert the following hangul character." (defvar-local hangul-input-method-help-text nil) ;;;###autoload -(defun hangul-input-method-activate (input-method func help-text &rest args) +(defun hangul-input-method-activate (_input-method func help-text &rest _args) "Activate Hangul input method INPUT-METHOD. FUNC is a function to handle input key. HELP-TEXT is a text set in `hangul-input-method-help-text'." - (setq deactivate-current-input-method-function 'hangul-input-method-deactivate - describe-current-input-method-function 'hangul-input-method-help + (setq deactivate-current-input-method-function #'hangul-input-method-deactivate + describe-current-input-method-function #'hangul-input-method-help hangul-input-method-help-text help-text) (quail-delete-overlays) (if (eq (selected-window) (minibuffer-window)) - (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)) + (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer)) (setq-local input-method-function func)) (defun hangul-input-method-deactivate () @@ -538,7 +538,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'." (define-obsolete-function-alias 'hangul-input-method-inactivate - 'hangul-input-method-deactivate "24.3") + #'hangul-input-method-deactivate "24.3") (defun hangul-input-method-help () "Describe the current Hangul input method." diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el index d9f58885f20..e805c6ad3b2 100644 --- a/lisp/leim/quail/ipa.el +++ b/lisp/leim/quail/ipa.el @@ -1,4 +1,4 @@ -;;; ipa.el --- Quail package for inputting IPA characters -*-coding: utf-8;-*- +;;; ipa.el --- Quail package for inputting IPA characters -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -276,7 +276,7 @@ string." (cl-assert (vectorp quail-keymap) t) (setq quail-keymap (append quail-keymap nil)))) (list - (apply 'vector + (apply #'vector (mapcar #'(lambda (entry) (cl-assert (char-or-string-p entry) t) @@ -502,9 +502,9 @@ of the mapping.") ;; diacritic. To avoid this, handle the input specially with the function ;; ipa-x-sampa-underscore-implosive. -(dolist (implosive-x-sampa (mapcar 'car ipa-x-sampa-implosive-submap)) +(dolist (implosive-x-sampa (mapcar #'car ipa-x-sampa-implosive-submap)) (setq implosive-x-sampa (car (split-string implosive-x-sampa "_"))) (quail-defrule (format "%s_" implosive-x-sampa) - 'ipa-x-sampa-underscore-implosive)) + #'ipa-x-sampa-underscore-implosive)) ;;; ipa.el ends here diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el index a4ea550c265..6a2bcdc9ed7 100644 --- a/lisp/leim/quail/japanese.el +++ b/lisp/leim/quail/japanese.el @@ -1,4 +1,4 @@ -;;; japanese.el --- Quail package for inputting Japanese +;;; japanese.el --- Quail package for inputting Japanese -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -412,7 +412,7 @@ C-h kkc-help List these key bindings. " nil t t nil nil nil nil nil - 'quail-japanese-update-translation + #'quail-japanese-update-translation '(("K" . quail-japanese-toggle-kana) (" " . quail-japanese-kanji-kkc) ("\C-m" . quail-no-conversion) @@ -491,7 +491,7 @@ qh: shift to the input method `japanese', qq: toggle between this input method and the input method `japanese-ascii'. " nil t t nil nil nil nil nil - 'quail-japanese-hankaku-update-translation) + #'quail-japanese-hankaku-update-translation) (dolist (elt quail-japanese-transliteration-rules) (quail-defrule (car elt) @@ -517,7 +517,7 @@ qq: toggle between this input method and the input method `japanese-ascii'. nil "Japanese hiragana input method by Roman transliteration." nil t t nil nil nil nil nil - 'quail-japanese-update-translation) + #'quail-japanese-update-translation) ;; Use the same map as that of `japanese'. (setcar (cdr (cdr quail-current-package)) @@ -538,7 +538,7 @@ qq: toggle between this input method and the input method `japanese-ascii'. nil "Japanese katakana input method by Roman transliteration." nil t t nil nil nil nil nil - 'quail-japanese-katakana-update-translation) + #'quail-japanese-katakana-update-translation) (dolist (elt quail-japanese-transliteration-rules) (quail-defrule (car elt) diff --git a/lisp/leim/quail/lao.el b/lisp/leim/quail/lao.el index af3b5892629..a932460a20a 100644 --- a/lisp/leim/quail/lao.el +++ b/lisp/leim/quail/lao.el @@ -1,4 +1,4 @@ -;;; lao.el --- Quail package for inputting Lao characters -*-coding: utf-8;-*- +;;; lao.el --- Quail package for inputting Lao characters -*- lexical-binding: t; -*- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, ;; 2006, 2007, 2008, 2009, 2010, 2011 @@ -195,7 +195,7 @@ you need to re-load it to properly re-initialize related alists.") (quail-define-package "lao" "Lao" "ລ" t "Lao input method simulating Lao keyboard layout based on Thai TIS620" - nil t t t t nil nil nil 'quail-lao-update-translation nil t) + nil t t t t nil nil nil #'quail-lao-update-translation nil t) (quail-install-map (quail-map-from-table diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index fd78253c4fb..8b1e5203613 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -1,4 +1,4 @@ -;;; latin-ltx.el --- Quail package for TeX-style input -*-coding: utf-8;-*- +;;; latin-ltx.el --- Quail package for TeX-style input -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, diff --git a/lisp/leim/quail/lrt.el b/lisp/leim/quail/lrt.el index e05bc1e6cb7..68eaeb58ec6 100644 --- a/lisp/leim/quail/lrt.el +++ b/lisp/leim/quail/lrt.el @@ -1,4 +1,4 @@ -;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*-coding: utf-8;-*- +;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*- lexical-binding: t; -*- ;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -60,7 +60,7 @@ `\\' (backslash) + `$' => ຯ LAO ELLIPSIS " nil 'forget-last-selection 'deterministic 'kbd-translate 'show-layout - nil nil nil 'quail-lrt-update-translation nil t) + nil nil nil #'quail-lrt-update-translation nil t) ;; LRT (Lao Roman Transcription) input method accepts the following ;; key sequence: diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el index 8e7a500276a..aa35bb0574f 100644 --- a/lisp/leim/quail/sisheng.el +++ b/lisp/leim/quail/sisheng.el @@ -1,4 +1,4 @@ -;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration +;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/thai.el b/lisp/leim/quail/thai.el index 7cf11daf9d0..07ba657f9b8 100644 --- a/lisp/leim/quail/thai.el +++ b/lisp/leim/quail/thai.el @@ -1,4 +1,4 @@ -;;; thai.el --- Quail package for inputting Thai characters -*-coding: utf-8;-*- +;;; thai.el --- Quail package for inputting Thai characters -*- lexical-binding: t; -*- ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el index a54763d56f6..33cc6f5965f 100644 --- a/lisp/leim/quail/tibetan.el +++ b/lisp/leim/quail/tibetan.el @@ -1,4 +1,4 @@ -;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: utf-8-emacs;-*- +;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: utf-8-emacs; lexical-binding: t; -*- ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -158,7 +158,7 @@ Tsheg is assigned to SPC. Space is assigned to period `.'. " nil nil nil nil nil nil nil nil - 'quail-tibetan-update-translation) + #'quail-tibetan-update-translation) ;; Here we build up a Quail map for a Tibetan sequence the whole of ;; which can be one composition. @@ -371,7 +371,7 @@ (setq trans-list (cons trans trans-list) i last) (setq trans-list nil i len)))) - (apply 'concat (nreverse trans-list)))) + (apply #'concat (nreverse trans-list)))) (defvar quail-tibkey-characters nil) @@ -440,7 +440,7 @@ I hope I'll complete in a future revision. " nil nil nil nil nil nil nil nil - 'quail-tibkey-update-translation) + #'quail-tibkey-update-translation) (quail-install-map (quail-map-from-table diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el index c7cf6abe2aa..bfe4ce6f120 100644 --- a/lisp/leim/quail/uni-input.el +++ b/lisp/leim/quail/uni-input.el @@ -1,4 +1,4 @@ -;;; uni-input.el --- Hex Unicode input method +;;; uni-input.el --- Hex Unicode input method -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 @@ -57,11 +57,12 @@ (echo-keystrokes 0) (help-char nil) (events (list key)) - (str " ")) + ;; (str " ") + ) (unwind-protect (catch 'non-digit (progn - (dotimes (i 4) + (dotimes (_ 4) (let ((seq (read-key-sequence nil)) key) (if (and (stringp seq) @@ -76,7 +77,7 @@ (throw 'non-digit (append (reverse events) (listify-key-sequence seq)))))) (quail-delete-region) - (let ((n (string-to-number (apply 'string + (let ((n (string-to-number (apply #'string (cdr (nreverse events))) 16))) (if (characterp n) @@ -100,12 +101,12 @@ While this input method is active, the variable (quail-delete-overlays) (setq describe-current-input-method-function nil)) (kill-local-variable 'input-method-function)) - (setq deactivate-current-input-method-function 'ucs-input-deactivate) - (setq describe-current-input-method-function 'ucs-input-help) + (setq deactivate-current-input-method-function #'ucs-input-deactivate) + (setq describe-current-input-method-function #'ucs-input-help) (quail-delete-overlays) (if (eq (selected-window) (minibuffer-window)) - (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)) - (setq-local input-method-function 'ucs-input-method))) + (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer)) + (setq-local input-method-function #'ucs-input-method))) (defun ucs-input-deactivate () "Deactivate UCS input method." @@ -114,7 +115,7 @@ While this input method is active, the variable (define-obsolete-function-alias 'ucs-input-inactivate - 'ucs-input-deactivate "24.3") + #'ucs-input-deactivate "24.3") (defun ucs-input-help () (interactive) From 1be27e3bf36f5e984429f645bdce1bcb8e82c54c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Feb 2021 17:47:18 -0500 Subject: [PATCH 121/297] * lisp/play/decipher.el: Use lexical-binding (decipher-mode-syntax-table): Move initialization into declaration. (decipher-mode, decipher-stats-mode): Use `define-derived-mode`. (decipher-stats-buffer): Use `buffer-local-value`. --- lisp/play/decipher.el | 84 ++++++++++++++++++------------------------- 1 file changed, 34 insertions(+), 50 deletions(-) diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index 524ca81f30a..9b2626b19da 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -1,4 +1,4 @@ -;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers +;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers -*- lexical-binding: t; -*- ;; ;; Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc. ;; @@ -71,7 +71,7 @@ ;; Emacs commands. ;; ;; Decipher supports Font Lock mode. To use it, you can also add -;; (add-hook 'decipher-mode-hook 'turn-on-font-lock) +;; (add-hook 'decipher-mode-hook #'turn-on-font-lock) ;; See the variable `decipher-font-lock-keywords' if you want to customize ;; the faces used. I'd like to thank Simon Marshall for his help in making ;; Decipher work well with Font Lock. @@ -84,6 +84,8 @@ ;; 1. The consonant-line shortcut ;; 2. More functions for analyzing ciphertext +;;; Code: + ;;;=================================================================== ;;; Variables: ;;;=================================================================== @@ -139,20 +141,20 @@ the tail of the list." (defvar decipher-mode-map (let ((map (make-keymap))) (suppress-keymap map) - (define-key map "A" 'decipher-show-alphabet) - (define-key map "C" 'decipher-complete-alphabet) - (define-key map "D" 'decipher-digram-list) - (define-key map "F" 'decipher-frequency-count) - (define-key map "M" 'decipher-make-checkpoint) - (define-key map "N" 'decipher-adjacency-list) - (define-key map "R" 'decipher-restore-checkpoint) - (define-key map "U" 'decipher-undo) - (define-key map " " 'decipher-keypress) - (define-key map [remap undo] 'decipher-undo) - (define-key map [remap advertised-undo] 'decipher-undo) + (define-key map "A" #'decipher-show-alphabet) + (define-key map "C" #'decipher-complete-alphabet) + (define-key map "D" #'decipher-digram-list) + (define-key map "F" #'decipher-frequency-count) + (define-key map "M" #'decipher-make-checkpoint) + (define-key map "N" #'decipher-adjacency-list) + (define-key map "R" #'decipher-restore-checkpoint) + (define-key map "U" #'decipher-undo) + (define-key map " " #'decipher-keypress) + (define-key map [remap undo] #'decipher-undo) + (define-key map [remap advertised-undo] #'decipher-undo) (let ((key ?a)) (while (<= key ?z) - (define-key map (vector key) 'decipher-keypress) + (define-key map (vector key) #'decipher-keypress) (cl-incf key))) map) "Keymap for Decipher mode.") @@ -161,24 +163,21 @@ the tail of the list." (defvar decipher-stats-mode-map (let ((map (make-keymap))) (suppress-keymap map) - (define-key map "D" 'decipher-digram-list) - (define-key map "F" 'decipher-frequency-count) - (define-key map "N" 'decipher-adjacency-list) + (define-key map "D" #'decipher-digram-list) + (define-key map "F" #'decipher-frequency-count) + (define-key map "N" #'decipher-adjacency-list) map) -"Keymap for Decipher-Stats mode.") + "Keymap for Decipher-Stats mode.") -(defvar decipher-mode-syntax-table nil - "Decipher mode syntax table") - -(if decipher-mode-syntax-table - () +(defvar decipher-mode-syntax-table (let ((table (make-syntax-table)) (c ?0)) (while (<= c ?9) (modify-syntax-entry c "_" table) ;Digits are not part of words (cl-incf c)) - (setq decipher-mode-syntax-table table))) + table) + "Decipher mode syntax table") (defvar-local decipher-alphabet nil) ;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR), @@ -214,7 +213,6 @@ list of such cons cells.") (defvar decipher--freqs) ;;;=================================================================== -;;; Code: ;;;=================================================================== ;; Main entry points: ;;-------------------------------------------------------------------- @@ -256,7 +254,7 @@ ABCDEFGHIJKLMNOPQRSTUVWXYZ -*-decipher-*-\n)\n\n") (decipher-mode)) ;;;###autoload -(defun decipher-mode () +(define-derived-mode decipher-mode nil "Decipher" "Major mode for decrypting monoalphabetic substitution ciphers. Lower-case letters enter plaintext. Upper-case letters are commands. @@ -272,16 +270,10 @@ The most useful commands are: Show adjacency list for current letter (lists letters appearing next to it) \\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint) \\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)" - (interactive) - (kill-all-local-variables) (setq buffer-undo-list t ;Disable undo - indent-tabs-mode nil ;Do not use tab characters - major-mode 'decipher-mode - mode-name "Decipher") + indent-tabs-mode nil) ;Do not use tab characters (if decipher-force-uppercase (setq case-fold-search nil)) ;Case is significant when searching - (use-local-map decipher-mode-map) - (set-syntax-table decipher-mode-syntax-table) (unless (= (point-min) (point-max)) (decipher-read-alphabet)) (setq-local font-lock-defaults @@ -291,7 +283,6 @@ The most useful commands are: (lambda () (setq buffer-read-only nil buffer-undo-list nil)) nil t) - (run-mode-hooks 'decipher-mode-hook) (setq buffer-read-only t)) (put 'decipher-mode 'mode-class 'special) @@ -314,10 +305,10 @@ The most useful commands are: ((= ?> first-char) nil) ((= ?\( first-char) - (setq decipher-function 'decipher-alphabet-keypress) + (setq decipher-function #'decipher-alphabet-keypress) t) ((= ?\) first-char) - (setq decipher-function 'decipher-alphabet-keypress) + (setq decipher-function #'decipher-alphabet-keypress) nil) (t (error "Bad location"))))) @@ -456,7 +447,7 @@ The most useful commands are: (decipher-insert plain-char) (setq case-fold-search t ;Case is not significant cipher-string (downcase cipher-string)) - (let ((font-lock-fontify-region-function 'ignore)) + (let ((font-lock-fontify-region-function #'ignore)) ;; insert-and-inherit will pick the right face automatically (while (search-forward-regexp "^:" nil t) (setq bound (point-at-eol)) @@ -868,12 +859,12 @@ Creates the statistics buffer if it doesn't exist." (aset decipher--after i (make-vector 27 0)))) (if decipher-ignore-spaces (progn - (decipher-loop-no-breaks 'decipher--analyze) + (decipher-loop-no-breaks #'decipher--analyze) ;; The first character of ciphertext was marked as following a space: (let ((i 26)) (while (>= (cl-decf i) 0) (aset (aref decipher--after i) 26 0)))) - (decipher-loop-with-breaks 'decipher--analyze)) + (decipher-loop-with-breaks #'decipher--analyze)) (message "Processing results...") (setcdr (last decipher--digram-list 2) nil) ;Delete the phony "* " digram ;; Sort the digram list by frequency and alphabetical order: @@ -954,18 +945,12 @@ Creates the statistics buffer if it doesn't exist." ;; Statistics Buffer: ;;==================================================================== -(defun decipher-stats-mode () +(define-derived-mode decipher-stats-mode nil "Decipher-Stats" "Major mode for displaying ciphertext statistics." - (interactive) - (kill-all-local-variables) (setq buffer-read-only t buffer-undo-list t ;Disable undo case-fold-search nil ;Case is significant when searching - indent-tabs-mode nil ;Do not use tab characters - major-mode 'decipher-stats-mode - mode-name "Decipher-Stats") - (use-local-map decipher-stats-mode-map) - (run-mode-hooks 'decipher-stats-mode-hook)) + indent-tabs-mode nil)) ;Do not use tab characters (put 'decipher-stats-mode 'mode-class 'special) ;;-------------------------------------------------------------------- @@ -1001,9 +986,8 @@ if it can't, it signals an error." (let ((stats-name (concat "*" (buffer-name) "*"))) (setq decipher-stats-buffer (if (eq 'decipher-stats-mode - (cdr-safe (assoc 'major-mode - (buffer-local-variables - (get-buffer stats-name))))) + (buffer-local-value 'major-mode + (get-buffer stats-name))) ;; We just lost track of the statistics buffer: (get-buffer stats-name) (generate-new-buffer stats-name)))) From ad3e5da95359a15b1f615574ae0b39bade6efd67 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 20:54:48 +0100 Subject: [PATCH 122/297] * lisp/progmodes/cperl-mode.el (cperl-init-faces): Use regexp-opt. --- lisp/progmodes/cperl-mode.el | 159 +++++++++++++---------------------- 1 file changed, 59 insertions(+), 100 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index a70e8e36c0b..b1a49b25a32 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5415,120 +5415,79 @@ indentation and initial hashes. Behaves usually outside of comment." (cons (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" - ;; FIXME: Use regexp-opt. - (mapconcat - #'identity + (regexp-opt (append cperl-sub-keywords '("if" "until" "while" "elsif" "else" - "given" "when" "default" "break" - "unless" "for" - "try" "catch" "finally" - "foreach" "continue" "exit" "die" "last" "goto" "next" - "redo" "return" "local" "exec" - "do" "dump" - "use" "our" - "require" "package" "eval" "evalbytes" "my" "state" - "BEGIN" "END" "CHECK" "INIT" "UNITCHECK")) - "\\|") ; Flow control + "given" "when" "default" "break" + "unless" "for" + "try" "catch" "finally" + "foreach" "continue" "exit" "die" "last" "goto" "next" + "redo" "return" "local" "exec" + "do" "dump" + "use" "our" + "require" "package" "eval" "evalbytes" "my" "state" + "BEGIN" "END" "CHECK" "INIT" "UNITCHECK"))) ; Flow control "\\)\\>") 2) ; was "\\)[ \n\t;():,|&]" ; In what follows we use `type' style ; for overwritable builtins (list (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" - ;; FIXME: Use regexp-opt. - ;; "CORE" "__FILE__" "__LINE__" "__SUB__" "abs" "accept" "alarm" - ;; "and" "atan2" "bind" "binmode" "bless" "caller" - ;; "chdir" "chmod" "chown" "chr" "chroot" "close" - ;; "closedir" "cmp" "connect" "continue" "cos" "crypt" - ;; "dbmclose" "dbmopen" "die" "dump" "endgrent" - ;; "endhostent" "endnetent" "endprotoent" "endpwent" - ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fc" "fcntl" - ;; "fileno" "flock" "fork" "formline" "ge" "getc" - ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr" - ;; "gethostbyname" "gethostent" "getlogin" - ;; "getnetbyaddr" "getnetbyname" "getnetent" - ;; "getpeername" "getpgrp" "getppid" "getpriority" - ;; "getprotobyname" "getprotobynumber" "getprotoent" - ;; "getpwent" "getpwnam" "getpwuid" "getservbyname" - ;; "getservbyport" "getservent" "getsockname" - ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" - ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length" - ;; "link" "listen" "localtime" "lock" "log" "lstat" "lt" - ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne" - ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe" - ;; "quotemeta" "rand" "read" "readdir" "readline" - ;; "readlink" "readpipe" "recv" "ref" "rename" "require" - ;; "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek" - ;; "seekdir" "select" "semctl" "semget" "semop" "send" - ;; "setgrent" "sethostent" "setnetent" "setpgrp" - ;; "setpriority" "setprotoent" "setpwent" "setservent" - ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite" - ;; "shutdown" "sin" "sleep" "socket" "socketpair" - ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink" - ;; "syscall" "sysopen" "sysread" "sysseek" "system" "syswrite" "tell" - ;; "telldir" "time" "times" "truncate" "uc" "ucfirst" - ;; "umask" "unlink" "unpack" "utime" "values" "vec" - ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor" - "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|" - "b\\(in\\(d\\|mode\\)\\|less\\)\\|" - "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|" - "lose\\(\\|dir\\)\\|mp\\|o\\(s\\|n\\(tinue\\|nect\\)\\)\\)\\|" - "CORE\\|d\\(ie\\|bm\\(close\\|open\\)\\|ump\\)\\|" - "e\\(x\\(p\\|it\\|ec\\)\\|q\\|nd\\(p\\(rotoent\\|went\\)\\|" - "hostent\\|servent\\|netent\\|grent\\)\\|of\\)\\|" - "f\\(ileno\\|c\\(ntl\\)?\\|lock\\|or\\(k\\|mline\\)\\)\\|" - "g\\(t\\|lob\\|mtime\\|e\\(\\|t\\(p\\(pid\\|r\\(iority\\|" - "oto\\(byn\\(ame\\|umber\\)\\|ent\\)\\)\\|eername\\|w" - "\\(uid\\|ent\\|nam\\)\\|grp\\)\\|host\\(by\\(addr\\|name\\)\\|" - "ent\\)\\|s\\(erv\\(by\\(port\\|name\\)\\|ent\\)\\|" - "ock\\(name\\|opt\\)\\)\\|c\\|login\\|net\\(by\\(addr\\|name\\)\\|" - "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|" - "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|" - "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e" - "\\(\\|ngth\\)\\|o\\(c\\(altime\\|k\\)\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|" - "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|" - "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|" - "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin" - "\\(k\\|e\\)\\|dir\\)\\|set\\|cv\\|verse\\|f\\|winddir\\|name" - "\\)\\)\\|s\\(printf\\|qrt\\|rand\\|tat\\|ubstr\\|e\\(t\\(p\\(r" - "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|" - "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|" - "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|" - "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\|seek\\)\\|" - "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|" - "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|" - "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|" - "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|" - "x\\(\\|or\\)\\|__\\(FILE\\|LINE\\|PACKAGE\\|SUB\\)__" - "\\)\\>") 2 'font-lock-type-face) + (regexp-opt + '("CORE" "__FILE__" "__LINE__" "__SUB__" + "abs" "accept" "alarm" "and" "atan2" + "bind" "binmode" "bless" "caller" + "chdir" "chmod" "chown" "chr" "chroot" "close" + "closedir" "cmp" "connect" "continue" "cos" "crypt" + "dbmclose" "dbmopen" "die" "dump" "endgrent" + "endhostent" "endnetent" "endprotoent" "endpwent" + "endservent" "eof" "eq" "exec" "exit" "exp" "fc" "fcntl" + "fileno" "flock" "fork" "formline" "ge" "getc" + "getgrent" "getgrgid" "getgrnam" "gethostbyaddr" + "gethostbyname" "gethostent" "getlogin" + "getnetbyaddr" "getnetbyname" "getnetent" + "getpeername" "getpgrp" "getppid" "getpriority" + "getprotobyname" "getprotobynumber" "getprotoent" + "getpwent" "getpwnam" "getpwuid" "getservbyname" + "getservbyport" "getservent" "getsockname" + "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" + "ioctl" "join" "kill" "lc" "lcfirst" "le" "length" + "link" "listen" "localtime" "lock" "log" "lstat" "lt" + "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne" + "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe" + "quotemeta" "rand" "read" "readdir" "readline" + "readlink" "readpipe" "recv" "ref" "rename" "require" + "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek" + "seekdir" "select" "semctl" "semget" "semop" "send" + "setgrent" "sethostent" "setnetent" "setpgrp" + "setpriority" "setprotoent" "setpwent" "setservent" + "setsockopt" "shmctl" "shmget" "shmread" "shmwrite" + "shutdown" "sin" "sleep" "socket" "socketpair" + "sprintf" "sqrt" "srand" "stat" "substr" "symlink" + "syscall" "sysopen" "sysread" "sysseek" "system" "syswrite" "tell" + "telldir" "time" "times" "truncate" "uc" "ucfirst" + "umask" "unlink" "unpack" "utime" "values" "vec" + "wait" "waitpid" "wantarray" "warn" "write" "x" "xor")) + "\\)\\>") + 2 'font-lock-type-face) ;; In what follows we use `other' style ;; for nonoverwritable builtins - ;; Somehow 's', 'm' are not auto-generated??? (list (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" - ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "UNITCHECK" "__END__" "chomp" - ;; "break" "chop" "default" "defined" "delete" "do" "each" "else" "elsif" - ;; "eval" "evalbytes" "exists" "for" "foreach" "format" "given" "goto" - ;; "grep" "if" "keys" "last" "local" "map" "my" "next" - ;; "no" "our" "package" "pop" "pos" "print" "printf" "prototype" "push" - ;; "q" "qq" "qw" "qx" "redo" "return" "say" "scalar" "shift" - ;; "sort" "splice" "split" "state" "study" "sub" "tie" "tr" - ;; "undef" "unless" "unshift" "untie" "until" "use" - ;; "when" "while" "y" - "AUTOLOAD\\|BEGIN\\|\\(UNIT\\)?CHECK\\|break\\|c\\(atch\\|ho\\(p\\|mp\\)\\)\\|d\\(e\\(f\\(inally\\|ault\\|ined\\)\\|lete\\)\\|" - "o\\)\\|DESTROY\\|e\\(ach\\|val\\(bytes\\)?\\|xists\\|ls\\(e\\|if\\)\\)\\|" - "END\\|for\\(\\|each\\|mat\\)\\|g\\(iven\\|rep\\|oto\\)\\|INIT\\|if\\|keys\\|" - "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|" - "p\\(ackage\\|rototype\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|" - "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(ay\\|pli\\(ce\\|t\\)\\|" - "calar\\|t\\(ate\\|udy\\)\\|ub\\|hift\\|ort\\)\\|t\\(ry?\\|ied?\\)\\|" - "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" - "wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually - "\\|[sm]" ; Added manually - "\\)\\>") + (regexp-opt + '("AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "UNITCHECK" + "__END__" "__DATA__" "break" "catch" "chomp" "chop" "default" + "defined" "delete" "do" "each" "else" "elsif" "eval" + "evalbytes" "exists" "finally" "for" "foreach" "format" "given" + "goto" "grep" "if" "keys" "last" "local" "m" "map" "my" "next" + "no" "our" "package" "pop" "pos" "print" "printf" "prototype" + "push" "q" "qq" "qw" "qx" "redo" "return" "s" "say" "scalar" + "shift" "sort" "splice" "split" "state" "study" "sub" "tie" + "tied" "tr" "try" "undef" "unless" "unshift" "untie" "until" + "use" "when" "while" "y")) + "\\)\\>") 2 ''cperl-nonoverridable-face) ; unbound as var, so: doubly quoted ;; (mapconcat #'identity ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if" From aaa80f408cbfe9419c2bc140f358604cf0b1a7c7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Feb 2021 20:58:16 +0100 Subject: [PATCH 123/297] Avoid having erc in irrelevant finder categories * lisp/erc/erc-backend.el: * lisp/erc/erc-button.el: * lisp/erc/erc-dcc.el: * lisp/erc/erc-identd.el: * lisp/erc/erc-join.el: * lisp/erc/erc-lang.el: * lisp/erc/erc-log.el: * lisp/erc/erc-match.el: * lisp/erc/erc-menu.el: * lisp/erc/erc-pcomplete.el: * lisp/erc/erc-replace.el: * lisp/erc/erc-spelling.el: * lisp/erc/erc-stamp.el: * lisp/erc/erc-track.el: * lisp/erc/erc-xdcc.el: Remove irrelevant entries in Keywords header. --- lisp/erc/erc-backend.el | 2 +- lisp/erc/erc-button.el | 2 +- lisp/erc/erc-dcc.el | 2 +- lisp/erc/erc-identd.el | 2 +- lisp/erc/erc-join.el | 2 +- lisp/erc/erc-lang.el | 2 +- lisp/erc/erc-log.el | 2 +- lisp/erc/erc-match.el | 2 +- lisp/erc/erc-menu.el | 2 +- lisp/erc/erc-pcomplete.el | 2 +- lisp/erc/erc-replace.el | 2 +- lisp/erc/erc-spelling.el | 2 +- lisp/erc/erc-stamp.el | 2 +- lisp/erc/erc-track.el | 2 +- lisp/erc/erc-xdcc.el | 2 +- 15 files changed, 15 insertions(+), 15 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4cabd42f532..6f1193cbb2b 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -6,7 +6,7 @@ ;; Author: Lawrence Mitchell ;; Maintainer: Amin Bandali ;; Created: 2004-05-7 -;; Keywords: IRC chat client internet +;; Keywords: comm, IRC, chat, client, internet ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 71ff40877a8..0a81da38974 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -4,7 +4,7 @@ ;; Author: Mario Lang ;; Maintainer: Amin Bandali -;; Keywords: irc, button, url, regexp +;; Keywords: comm, irc, button, url, regexp ;; URL: https://www.emacswiki.org/emacs/ErcButton ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 9dedd3cda86..e72d8fbe3db 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -7,7 +7,7 @@ ;; Noah Friedman ;; Per Persson ;; Maintainer: Amin Bandali -;; Keywords: comm, processes +;; Keywords: comm ;; Created: 1994-01-23 ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el index 5f1aab1784b..1f68272ebb1 100644 --- a/lisp/erc/erc-identd.el +++ b/lisp/erc/erc-identd.el @@ -4,7 +4,7 @@ ;; Author: John Wiegley ;; Maintainer: Amin Bandali -;; Keywords: comm, processes +;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index e6e50707830..1707e714cc1 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -4,7 +4,7 @@ ;; Author: Alex Schroeder ;; Maintainer: Amin Bandali -;; Keywords: irc +;; Keywords: comm, irc ;; URL: https://www.emacswiki.org/emacs/ErcAutoJoin ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el index b86a8d0be2b..4163e5a08d0 100644 --- a/lisp/erc/erc-lang.el +++ b/lisp/erc/erc-lang.el @@ -6,7 +6,7 @@ ;; Maintainer: Amin Bandali ;; Old-Version: 1.0.0 ;; URL: https://www.emacswiki.org/emacs/ErcLang -;; Keywords: comm languages processes +;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 4540ec6808f..22fd3d27136 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -5,7 +5,7 @@ ;; Author: Lawrence Mitchell ;; Maintainer: Amin Bandali ;; URL: https://www.emacswiki.org/emacs/ErcLogging -;; Keywords: IRC, chat, client, Internet, logging +;; Keywords: comm, IRC, chat, client, Internet, logging ;; Created 2003-04-26 ;; Logging code taken from erc.el and modified to use markers. diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 153742a6706..eede15c11af 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -4,7 +4,7 @@ ;; Author: Andreas Fuchs ;; Maintainer: Amin Bandali -;; Keywords: comm, faces +;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcMatch ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index 4c092c834bc..3995a0564af 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -4,7 +4,7 @@ ;; Author: Mario Lang ;; Maintainer: Amin Bandali -;; Keywords: comm, processes, menu +;; Keywords: comm, menu ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index ddaf78774a6..e9ebf0a07a4 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -4,7 +4,7 @@ ;; Author: Sacha Chua ;; Maintainer: Amin Bandali -;; Keywords: comm, convenience +;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcCompletion ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el index 91fafbb6308..c67d7514037 100644 --- a/lisp/erc/erc-replace.el +++ b/lisp/erc/erc-replace.el @@ -6,7 +6,7 @@ ;; Author: Andreas Fuchs ;; Maintainer: Amin Bandali ;; URL: https://www.emacswiki.org/emacs/ErcReplace -;; Keywords: IRC, client, Internet +;; Keywords: comm, IRC, client, Internet ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el index 44a3e358812..c18ac5b3ec0 100644 --- a/lisp/erc/erc-spelling.el +++ b/lisp/erc/erc-spelling.el @@ -4,7 +4,7 @@ ;; Author: Jorgen Schaefer ;; Maintainer: Amin Bandali -;; Keywords: irc +;; Keywords: comm, irc ;; URL: https://www.emacswiki.org/emacs/ErcSpelling ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 2c42a18081e..da91364e9cc 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -4,7 +4,7 @@ ;; Author: Mario Lang ;; Maintainer: Amin Bandali -;; Keywords: comm, processes, timestamp +;; Keywords: comm, timestamp ;; URL: https://www.emacswiki.org/emacs/ErcStamp ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index d6ad847c5b9..56f66563ad6 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -4,7 +4,7 @@ ;; Author: Mario Lang ;; Maintainer: Amin Bandali -;; Keywords: comm, faces +;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcChannelTracking ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el index 6808f24911d..db8383ba20b 100644 --- a/lisp/erc/erc-xdcc.el +++ b/lisp/erc/erc-xdcc.el @@ -4,7 +4,7 @@ ;; Author: Mario Lang ;; Maintainer: Amin Bandali -;; Keywords: comm, processes +;; Keywords: comm ;; This file is part of GNU Emacs. From 0e2b123a4ef600f5b337972a7bb61c1fc4b7d0cd Mon Sep 17 00:00:00 2001 From: Andrii Kolomoiets Date: Thu, 11 Feb 2021 10:09:41 +0100 Subject: [PATCH 124/297] Use frame monitor in frame_float * src/frame.c (frame_float): Use frame monitor attributes instead of attributes of the main monitor (bug#46406). --- src/frame.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/frame.c b/src/frame.c index 635fc945604..a62347c1fb2 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3890,7 +3890,7 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, Lisp_Object frame; XSETFRAME (frame, f); - monitor_attributes = Fcar (call1 (Qdisplay_monitor_attributes_list, frame)); + monitor_attributes = call1 (Qframe_monitor_attributes, frame); if (NILP (monitor_attributes)) { /* No monitor attributes available. */ @@ -5890,7 +5890,7 @@ syms_of_frame (void) DEFSYM (Qframep, "framep"); DEFSYM (Qframe_live_p, "frame-live-p"); DEFSYM (Qframe_windows_min_size, "frame-windows-min-size"); - DEFSYM (Qdisplay_monitor_attributes_list, "display-monitor-attributes-list"); + DEFSYM (Qframe_monitor_attributes, "frame-monitor-attributes"); DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total"); DEFSYM (Qexplicit_name, "explicit-name"); DEFSYM (Qheight, "height"); From 21ec45c10727403421c41c8c67a752458790afbb Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 10 Feb 2021 01:30:08 +0000 Subject: [PATCH 125/297] Fix Octave double-quoted string line continuations * lisp/progmodes/octave.el (octave-string-continuation-marker): New defconst after octave-continuation-string. (octave-continuation-string): Mention it in docstring. (octave-maybe-insert-continuation-string): Mark unused function as obsolete. (octave-help-function): Simplify action. (octave--indent-new-comment-line): Insert octave-string-continuation-marker instead of octave-continuation-string within double-quoted strings (bug#46420). (octave-indent-new-comment-line): * etc/NEWS: Describe new behavior. --- doc/misc/octave-mode.texi | 5 +++- etc/NEWS | 9 +++++++ lisp/progmodes/octave.el | 49 +++++++++++++++++++++------------------ 3 files changed, 39 insertions(+), 24 deletions(-) diff --git a/doc/misc/octave-mode.texi b/doc/misc/octave-mode.texi index 1adc2689697..e3306060159 100644 --- a/doc/misc/octave-mode.texi +++ b/doc/misc/octave-mode.texi @@ -83,9 +83,12 @@ addition to the standard Emacs commands. @kindex C-M-j @findex octave-indent-new-comment-line @vindex octave-continuation-string +@vindex octave-string-continuation-marker Break Octave line at point, continuing comment if within one. Insert @code{octave-continuation-string} before breaking the line unless -inside a list. Signal an error if within a single-quoted string. +inside a list. If within a double-quoted string, insert +@code{octave-string-continuation-marker} instead. Signal an error if +within a single-quoted string. @item C-c ; @kindex C-c ; diff --git a/etc/NEWS b/etc/NEWS index 67fc49f1817..2f15f078a75 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2018,6 +2018,15 @@ could have saved enough typing by using an abbrev, a hint will be displayed in the echo area, mentioning the abbrev that could have been used instead. +** Octave Mode + ++++ +*** Line continuations in double-quoted strings now use a backslash. +Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows +the behavior introduced in Octave 3.8 of using a backslash as a line +continuation marker within double-quoted strings, and an ellipsis +everywhere else. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index ddcc6f5450e..a8a86478d8b 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -215,9 +215,15 @@ newline or semicolon after an else or end keyword." (concat "[^#%\n]*\\(" octave-continuation-marker-regexp "\\)\\s-*\\(\\s<.*\\)?$")) -;; Char \ is considered a bad decision for continuing a line. (defconst octave-continuation-string "..." - "Character string used for Octave continuation lines.") + "Character string used for Octave continuation lines. +Joins current line with following line, except within +double-quoted strings, where `octave-string-continuation-marker' +is used instead.") + +(defconst octave-string-continuation-marker "\\" + "Line continuation marker for double-quoted Octave strings. +Non-string statements use `octave-continuation-string'.") (defvar octave-mode-imenu-generic-expression (list @@ -1032,11 +1038,11 @@ directory and makes this the current buffer's default directory." (looking-at regexp))) (defun octave-maybe-insert-continuation-string () - (if (or (octave-in-comment-p) - (save-excursion - (beginning-of-line) - (looking-at octave-continuation-regexp))) - nil + (declare (obsolete nil "28.1")) + (unless (or (octave-in-comment-p) + (save-excursion + (beginning-of-line) + (looking-at octave-continuation-regexp))) (delete-horizontal-space) (insert (concat " " octave-continuation-string)))) @@ -1218,23 +1224,22 @@ q: Don't fix\n" func file)) (defun octave-indent-new-comment-line (&optional soft) "Break Octave line at point, continuing comment if within one. Insert `octave-continuation-string' before breaking the line -unless inside a list. Signal an error if within a single-quoted -string." +unless inside a list. If within a double-quoted string, insert +`octave-string-continuation-marker' instead. Signal an error if +within a single-quoted string." (interactive) (funcall comment-line-break-function soft)) (defun octave--indent-new-comment-line (orig &rest args) - (cond - ((octave-in-comment-p) nil) - ((eq (octave-in-string-p) ?') - (error "Cannot split a single-quoted string")) - ((eq (octave-in-string-p) ?\") - (insert octave-continuation-string)) - (t - (delete-horizontal-space) - (unless (and (cadr (syntax-ppss)) - (eq (char-after (cadr (syntax-ppss))) ?\()) - (insert " " octave-continuation-string)))) + (pcase (syntax-ppss) + ((app ppss-string-terminator ?\') + (user-error "Cannot split a single-quoted string")) + ((app ppss-string-terminator ?\") + (insert octave-string-continuation-marker)) + ((pred (not ppss-comment-depth)) + (delete-horizontal-space) + (unless (octave-smie--in-parens-p) + (insert " " octave-continuation-string)))) (apply orig args) (indent-according-to-mode)) @@ -1663,9 +1668,7 @@ code line." (define-button-type 'octave-help-function 'follow-link t - 'action (lambda (b) - (octave-help - (buffer-substring (button-start b) (button-end b))))) + 'action (lambda (b) (octave-help (button-label b)))) (defvar octave-help-mode-map (let ((map (make-sparse-keymap))) From b3362f7b705d004f53792406f4fdac78e8370fc7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Feb 2021 15:40:45 +0100 Subject: [PATCH 126/297] ; Fix lexical-binding conversion of semantic/bovine/gcc.el * lisp/cedet/semantic/bovine/gcc.el (semantic-gcc-get-include-paths): Fix sorting and comparison after previous lexical-binding conversion. --- lisp/cedet/semantic/bovine/gcc.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 9cd9cdcb84b..c2121e5d587 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -89,8 +89,9 @@ to give to the program." (let ((path (substring line 1))) (when (and (file-accessible-directory-p path) (file-name-absolute-p path)) - (cl-pushnew (expand-file-name path) inc-path)))))))) - inc-path)) + (cl-pushnew (expand-file-name path) inc-path + :test #'equal)))))))) + (nreverse inc-path))) (defun semantic-cpp-defs (str) From c553fdc80c45c3cb3a609f85c3573d0fbc95c1a5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Feb 2021 19:18:38 +0100 Subject: [PATCH 127/297] Fix two Emacs version references in misc manuals * doc/misc/forms.texi: Fix reference to Emacs version. * doc/misc/remember.texi: Fix version reference to indicate Emacs version instead of version of remember. The corresponding version variable and header have been marked obsolete. --- doc/misc/forms.texi | 3 ++- doc/misc/remember.texi | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi index 3d7ac96cc24..15fcd97c5b9 100644 --- a/doc/misc/forms.texi +++ b/doc/misc/forms.texi @@ -6,6 +6,7 @@ @setfilename ../../info/forms.info @settitle Forms Mode User's Manual @include docstyle.texi +@include emacsver.texi @syncodeindex vr cp @syncodeindex fn cp @syncodeindex ky cp @@ -47,7 +48,7 @@ modify this GNU manual.'' @sp 4 @center Forms-Mode version 2 @sp 1 -@center for GNU Emacs 22.1 +@center for GNU Emacs @value{EMACSVER} @sp 1 @center April 2007 @sp 5 diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi index 80065be0a16..91e67a8798b 100644 --- a/doc/misc/remember.texi +++ b/doc/misc/remember.texi @@ -3,11 +3,12 @@ @setfilename ../../info/remember.info @settitle Remember Manual @include docstyle.texi +@include emacsver.texi @syncodeindex fn cp @c %**end of header @copying -This manual is for Remember Mode, version 2.0 +This manual is for Remember Mode, as distributed with Emacs @value{EMACSVER}. Copyright @copyright{} 2001, 2004--2005, 2007--2021 Free Software Foundation, Inc. From c99460cbf6ac9345059f87f4620700bde7f32b67 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Feb 2021 20:10:31 +0100 Subject: [PATCH 128/297] * lisp/ps-samp.el: Use lexical-binding. --- lisp/ps-samp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index fdff0f182db..22a29b8b4b1 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -1,4 +1,4 @@ -;;; ps-samp.el --- ps-print sample setup code +;;; ps-samp.el --- ps-print sample setup code -*- lexical-binding: t -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. From a24be5ef7e29fd3626f355abf3a8be3b19188d13 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Feb 2021 20:21:16 +0100 Subject: [PATCH 129/297] Use lexical-binding in wid-browse.el * lisp/wid-browse.el: Use lexical-binding. (widget-browse-mode): Use define-derived-mode. (widget-browse-mode-hook): Remove redundant :group arg. (widget-browse-action, widget-browse-value-create): Doc fixes. --- lisp/wid-browse.el | 23 ++++++----------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index 0864e1b313e..124cb04486c 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -56,11 +56,10 @@ ["Browse At" widget-browse-at t])) (defcustom widget-browse-mode-hook nil - "Hook called when entering widget-browse-mode." - :type 'hook - :group 'widget-browse) + "Hook run after entering `widget-browse-mode'." + :type 'hook) -(defun widget-browse-mode () +(define-derived-mode widget-browse-mode special-mode "Widget Browse" "Major mode for widget browser buffers. The following commands are available: @@ -68,15 +67,7 @@ The following commands are available: \\[widget-forward] Move to next button or editable field. \\[widget-backward] Move to previous button or editable field. \\[widget-button-click] Activate button under the mouse pointer. -\\[widget-button-press] Activate button under point. - -Entry to this mode calls the value of `widget-browse-mode-hook' -if that value is non-nil." - (kill-all-local-variables) - (setq major-mode 'widget-browse-mode - mode-name "Widget") - (use-local-map widget-browse-mode-map) - (run-mode-hooks 'widget-browse-mode-hook)) +\\[widget-button-press] Activate button under point.") (put 'widget-browse-mode 'mode-class 'special) @@ -190,11 +181,11 @@ The :value of the widget should be the widget to be browsed." :action 'widget-browse-action) (defun widget-browse-action (widget &optional _event) - ;; Create widget browser for WIDGET's :value. + "Create widget browser for :value of WIDGET." (widget-browse (widget-get widget :value))) (defun widget-browse-value-create (widget) - ;; Insert type name. + "Insert type name for WIDGET." (let ((value (widget-get widget :value))) (cond ((symbolp value) (insert (symbol-name value))) @@ -273,8 +264,6 @@ VALUE is assumed to be a list of widgets." "Minor mode for traversing widgets." :lighter " Widget") -;;; The End: - (provide 'wid-browse) ;;; wid-browse.el ends here From f29c7d61d7e143458a7452e4b1c439c85dbe3bc9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Feb 2021 20:59:41 +0100 Subject: [PATCH 130/297] Use lexical-binding in various ede files * lisp/cedet/ede/dired.el: * lisp/cedet/ede/emacs.el: * lisp/cedet/ede/make.el: * lisp/cedet/ede/proj-archive.el: * lisp/cedet/ede/proj-aux.el: * lisp/cedet/ede/proj-misc.el: * lisp/cedet/ede/proj-scheme.el: * lisp/cedet/ede/srecode.el: * lisp/cedet/ede/system.el: Use lexical-binding. --- lisp/cedet/ede/dired.el | 2 +- lisp/cedet/ede/emacs.el | 2 +- lisp/cedet/ede/make.el | 2 +- lisp/cedet/ede/proj-archive.el | 4 ++-- lisp/cedet/ede/proj-aux.el | 2 +- lisp/cedet/ede/proj-misc.el | 2 +- lisp/cedet/ede/proj-scheme.el | 4 ++-- lisp/cedet/ede/srecode.el | 3 +-- lisp/cedet/ede/system.el | 2 +- 9 files changed, 11 insertions(+), 12 deletions(-) diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el index c85d4ee7924..7eb42ed9de8 100644 --- a/lisp/cedet/ede/dired.el +++ b/lisp/cedet/ede/dired.el @@ -1,4 +1,4 @@ -;;; ede/dired.el --- EDE extensions to dired. +;;; ede/dired.el --- EDE extensions to dired. -*- lexical-binding: t -*- ;; Copyright (C) 1998-2000, 2003, 2009-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index 1eb4c6395a4..332f09bc5b0 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -1,4 +1,4 @@ -;;; ede/emacs.el --- Special project for Emacs +;;; ede/emacs.el --- Special project for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el index 863d715e4f1..4f86558c626 100644 --- a/lisp/cedet/ede/make.el +++ b/lisp/cedet/ede/make.el @@ -1,4 +1,4 @@ -;;; ede/make.el --- General information about "make" +;;; ede/make.el --- General information about "make" -*- lexical-binding: t -*- ;;; Copyright (C) 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el index 038f994e4f9..9da6374d09c 100644 --- a/lisp/cedet/ede/proj-archive.el +++ b/lisp/cedet/ede/proj-archive.el @@ -1,4 +1,4 @@ -;;; ede/proj-archive.el --- EDE Generic Project archive support +;;; ede/proj-archive.el --- EDE Generic Project archive support -*- lexical-binding: t -*- ;; Copyright (C) 1998-2001, 2009-2021 Free Software Foundation, Inc. @@ -45,7 +45,7 @@ "Linker object for creating an archive.") (cl-defmethod ede-proj-makefile-insert-source-variables :before - ((this ede-proj-target-makefile-archive) &optional moresource) + ((this ede-proj-target-makefile-archive) &optional _moresource) "Insert bin_PROGRAMS variables needed by target THIS. We aren't actually inserting SOURCE details, but this is used by the Makefile.am generator, so use it to add this important bin program." diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el index f5bcebdd4cf..73259558a62 100644 --- a/lisp/cedet/ede/proj-aux.el +++ b/lisp/cedet/ede/proj-aux.el @@ -1,4 +1,4 @@ -;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support +;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support -*- lexical-binding: t -*- ;; Copyright (C) 1998-2000, 2007, 2009-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el index 70132aff6c3..068e998d1a1 100644 --- a/lisp/cedet/ede/proj-misc.el +++ b/lisp/cedet/ede/proj-misc.el @@ -1,4 +1,4 @@ -;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support +;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support -*- lexical-binding: t -*- ;; Copyright (C) 1998-2001, 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el index 51844af5361..b0e287895f3 100644 --- a/lisp/cedet/ede/proj-scheme.el +++ b/lisp/cedet/ede/proj-scheme.el @@ -1,4 +1,4 @@ -;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support +;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support -*- lexical-binding: t -*- ;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc. @@ -40,7 +40,7 @@ ) "This target consists of scheme files.") -(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme)) +(cl-defmethod ede-proj-tweak-autoconf ((_this ede-proj-target-scheme)) "Tweak the configure file (current buffer) to accommodate THIS." (autoconf-insert-new-macro "AM_INIT_GUILE_MODULE")) diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el index 5dd0a7ec614..dd009bfb31a 100644 --- a/lisp/cedet/ede/srecode.el +++ b/lisp/cedet/ede/srecode.el @@ -1,4 +1,4 @@ -;;; ede/srecode.el --- EDE utilities on top of SRecoder +;;; ede/srecode.el --- EDE utilities on top of SRecoder -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -86,7 +86,6 @@ Note: Just like `srecode-insert', but templates found in `ede' app." (car (cdr dictionary-entries))) (setq dictionary-entries (cdr (cdr dictionary-entries)))) - )) (provide 'ede/srecode) diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el index d83d6d1cc69..8ef38f0d33e 100644 --- a/lisp/cedet/ede/system.el +++ b/lisp/cedet/ede/system.el @@ -1,4 +1,4 @@ -;;; ede-system.el --- EDE working with the system (VC, FTP, ETC) +;;; ede-system.el --- EDE working with the system (VC, FTP, ETC) -*- lexical-binding: t -*- ;; Copyright (C) 2001-2003, 2009-2021 Free Software Foundation, Inc. From 0bcec1e4ae0028d6f0f4c04ab2717f6fdadb79c1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Feb 2021 21:08:17 +0100 Subject: [PATCH 131/297] Drop XEmacs and SXEmacs support from EDE * lisp/cedet/ede/emacs.el (ede-emacs-version): Drop XEmacs and SXEmacs support from EDE. --- lisp/cedet/ede/emacs.el | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index 332f09bc5b0..00496ace16f 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -54,31 +54,6 @@ Return a tuple of ( EMACSNAME . VERSION )." (erase-buffer) (setq default-directory (file-name-as-directory dir)) (cond - ;; Maybe XEmacs? - ((file-exists-p "version.sh") - (setq emacs "XEmacs") - (insert-file-contents "version.sh") - (goto-char (point-min)) - (re-search-forward "emacs_major_version=\\([0-9]+\\) -emacs_minor_version=\\([0-9]+\\) -emacs_beta_version=\\([0-9]+\\)") - (setq ver (concat (match-string 1) "." - (match-string 2) "." - (match-string 3))) - ) - ((file-exists-p "sxemacs.pc.in") - (setq emacs "SXEmacs") - (insert-file-contents "sxemacs_version.m4") - (goto-char (point-min)) - (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\]) -m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\]) -m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])") - (setq ver (concat (match-string 1) "." - (match-string 2) "." - (match-string 3))) - ) - ;; Insert other Emacs here... - ;; Vaguely recent version of GNU Emacs? ((or (file-exists-p configure_ac) (file-exists-p (setq configure_ac "configure.in"))) From 4f63b4bfc6c16abeaf9d8a9e9de76cc42d772567 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Feb 2021 21:30:23 +0100 Subject: [PATCH 132/297] Use lexical-binding in erc-sound.el * lisp/erc/erc-sound.el: Use lexical-binding. Remove redundant :group args. --- lisp/erc/erc-sound.el | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el index edde9737ff9..fff1639a9de 100644 --- a/lisp/erc/erc-sound.el +++ b/lisp/erc/erc-sound.el @@ -1,4 +1,4 @@ -;;; erc-sound.el --- CTCP SOUND support for ERC +;;; erc-sound.el --- CTCP SOUND support for ERC -*- lexical-binding: t -*- ;; Copyright (C) 2002-2003, 2006-2021 Free Software Foundation, Inc. @@ -66,18 +66,15 @@ and play sound files as requested." (defcustom erc-play-sound t "Play sounds when you receive CTCP SOUND requests." - :group 'erc-sound :type 'boolean) (defcustom erc-sound-path nil "List of directories that contain sound samples to play on SOUND events." - :group 'erc-sound :type '(repeat directory)) (defcustom erc-default-sound nil "Play this sound if the requested file was not found. If this is set to nil or the file doesn't exist a beep will sound." - :group 'erc-sound :type '(choice (const nil) file)) @@ -108,7 +105,7 @@ LINE is the text entered, including the command." t)) (t nil))) -(defun erc-ctcp-query-SOUND (proc nick login host to msg) +(defun erc-ctcp-query-SOUND (_proc nick login host _to msg) "Display a CTCP SOUND message and play sound if `erc-play-sound' is non-nil." (when (string-match "^SOUND\\s-+\\(\\S-+\\)\\(\\(\\s-+.*\\)\\|\\(\\s-*\\)\\)$" msg) (let ((sound (match-string 1 msg)) From 203e61ff837128b397eb313a5bb1b703f0eae0ec Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 11 Feb 2021 21:37:45 +0000 Subject: [PATCH 133/297] Make recursive minibuffers and recursive edits work together * lisp/minibuffer.el (exit-minibuffer): When in a minibuffer, throw an error should the command loop nesting level be wrong. * src/lisp.h (minibuffer_quit_level): declare as an extern. (command_loop_level): Move definition from src/window.h * src/window.h (command_loop_level): move definition to src/lisp.h. * src/eval.c (minibuffer_quit_level): Move this variable to file level from being a static inside internal_catch. (internal_catch): Simplify the logic. * src/minibuf.c (Vcommand_loop_level_list): New variable. (move_minibuffer_onto_frame): Set the major mode of *Minibuf-0*. (Fminibuffer_innermost_command_loop_p): New primitive. (Fabort_minibuffers): Check the command loop level before throwing t to 'exit, and set minibuffer_quit_level too. (read_minibuf): New variable calling_window. Before stacking up minibuffers on the current mini-window, check that the mini-window is not the current one. Do not call choose_minibuf_frame from read_minibuf's unwinding process. Bind calling_frame and calling_window over the recursive edit. Set the new minibuffer's major mode directly. Remove the switching away from the minibuffer after the recursive edit. (get_minibuffer): Record the command loop level in new variable Vcommand_loop_level_list. No longer set the major mode of a returned minibuffer. (minibuf_c_loop_level): New function. (read_minibuf_unwind): New variables calling_frame, calling_window are unbound from the binding stack. Remove old variable `window', which could not be set reliably to the expired mini-window. The expired minibuffer is determined as the nth in the list, rather than the contents of the current or previous mini-window. Switch the current window away from the mini-window here (moved from read_minibuf). --- lisp/minibuffer.el | 13 ++--- src/eval.c | 32 ++++++------- src/lisp.h | 2 + src/minibuf.c | 115 +++++++++++++++++++++++++++++++++------------ src/window.h | 4 -- 5 files changed, 107 insertions(+), 59 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index a899a943d4c..aacb8ab00bb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2116,18 +2116,19 @@ variables.") (defun exit-minibuffer () "Terminate this minibuffer argument." (interactive) - (when (or - (innermost-minibuffer-p) - (not (minibufferp))) + (when (minibufferp) + (when (not (minibuffer-innermost-command-loop-p)) + (error "%s" "Not in most nested command loop")) + (when (not (innermost-minibuffer-p)) + (error "%s" "Not in most nested minibuffer"))) ;; If the command that uses this has made modifications in the minibuffer, ;; we don't want them to cause deactivation of the mark in the original ;; buffer. ;; A better solution would be to make deactivate-mark buffer-local ;; (or to turn it into a list of buffers, ...), but in the mean time, ;; this should do the trick in most cases. - (setq deactivate-mark nil) - (throw 'exit nil)) - (error "%s" "Not in most nested minibuffer")) + (setq deactivate-mark nil) + (throw 'exit nil)) (defun self-insert-and-exit () "Terminate minibuffer input." diff --git a/src/eval.c b/src/eval.c index 3aff3b56d52..91fc4e68377 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1165,21 +1165,23 @@ usage: (catch TAG BODY...) */) FUNC should return a Lisp_Object. This is how catches are done from within C code. */ +/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by + throwing t to tag `exit'. + 0 means there is no (throw 'exit t) in progress, or it wasn't from + a minibuffer which isn't the most nested; + N > 0 means the `throw' was done from the minibuffer at level N which + wasn't the most nested. */ +EMACS_INT minibuffer_quit_level = 0; + Lisp_Object internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) { - /* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by - throwing t to tag `exit'. - Value -1 means there is no (throw 'exit t) in progress; - 0 means the `throw' wasn't done from an active minibuffer; - N > 0 means the `throw' was done from the minibuffer at level N. */ - static EMACS_INT minibuffer_quit_level = -1; /* This structure is made part of the chain `catchlist'. */ struct handler *c = push_handler (tag, CATCHER); if (EQ (tag, Qexit)) - minibuffer_quit_level = -1; + minibuffer_quit_level = 0; /* Call FUNC. */ if (! sys_setjmp (c->jmp)) @@ -1194,22 +1196,16 @@ internal_catch (Lisp_Object tag, Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - if (EQ (tag, Qexit) && EQ (val, Qt)) + if (EQ (tag, Qexit) && EQ (val, Qt) && minibuffer_quit_level > 0) /* If we've thrown t to tag `exit' from within a minibuffer, we exit all minibuffers more deeply nested than the current one. */ { - EMACS_INT mini_depth = this_minibuffer_depth (Qnil); - if (mini_depth && mini_depth != minibuffer_quit_level) - { - if (minibuffer_quit_level == -1) - minibuffer_quit_level = mini_depth; - if (minibuffer_quit_level - && (minibuf_level > minibuffer_quit_level)) - Fthrow (Qexit, Qt); - } + if (minibuf_level > minibuffer_quit_level + && !NILP (Fminibuffer_innermost_command_loop_p (Qnil))) + Fthrow (Qexit, Qt); else - minibuffer_quit_level = -1; + minibuffer_quit_level = 0; } return val; } diff --git a/src/lisp.h b/src/lisp.h index 409a1e70608..0847324d1ff 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4091,6 +4091,7 @@ intern_c_string (const char *str) } /* Defined in eval.c. */ +extern EMACS_INT minibuffer_quit_level; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vrun_hooks; extern Lisp_Object Vsignaling_function; @@ -4369,6 +4370,7 @@ extern void syms_of_casetab (void); /* Defined in keyboard.c. */ +extern EMACS_INT command_loop_level; extern Lisp_Object echo_message_buffer; extern struct kboard *echo_kboard; extern void cancel_echoing (void); diff --git a/src/minibuf.c b/src/minibuf.c index 949c3d989d5..4b1f4b1ff72 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -41,6 +41,7 @@ along with GNU Emacs. If not, see . */ minibuffer recursions are encountered. */ Lisp_Object Vminibuffer_list; +Lisp_Object Vcommand_loop_level_list; /* Data to remember during recursive minibuffer invocations. */ @@ -64,6 +65,8 @@ static Lisp_Object minibuf_prompt; static ptrdiff_t minibuf_prompt_width; static Lisp_Object nth_minibuffer (EMACS_INT depth); +static EMACS_INT minibuf_c_loop_level (EMACS_INT depth); +static void set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth); /* Return TRUE when a frame switch causes a minibuffer on the old @@ -181,7 +184,12 @@ void move_minibuffer_onto_frame (void) set_window_buffer (sf->minibuffer_window, nth_minibuffer (i), 0, 0); minibuf_window = sf->minibuffer_window; if (of != sf) - set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0); + { + Lisp_Object temp = get_minibuffer (0); + + set_window_buffer (of->minibuffer_window, temp, 0, 0); + set_minibuffer_mode (temp, 0); + } } } @@ -389,6 +397,21 @@ No argument or nil as argument means use the current buffer as BUFFER. */) : Qnil; } +DEFUN ("minibuffer-innermost-command-loop-p", Fminibuffer_innermost_command_loop_p, + Sminibuffer_innermost_command_loop_p, 0, 1, 0, + doc: /* Return t if BUFFER is a minibuffer at the current command loop level. +No argument or nil as argument means use the current buffer as BUFFER. */) + (Lisp_Object buffer) +{ + EMACS_INT depth; + if (NILP (buffer)) + buffer = Fcurrent_buffer (); + depth = this_minibuffer_depth (buffer); + return depth && minibuf_c_loop_level (depth) == command_loop_level + ? Qt + : Qnil; +} + /* Return the nesting depth of the active minibuffer BUFFER, or 0 if BUFFER isn't such a thing. If BUFFER is nil, this means use the current buffer. */ @@ -420,12 +443,17 @@ confirm the aborting of the current minibuffer and all contained ones. */) if (!minibuf_depth) error ("Not in a minibuffer"); + if (NILP (Fminibuffer_innermost_command_loop_p (Qnil))) + error ("Not in most nested command loop"); if (minibuf_depth < minibuf_level) { array[0] = fmt; array[1] = make_fixnum (minibuf_level - minibuf_depth + 1); if (!NILP (Fyes_or_no_p (Fformat (2, array)))) - Fthrow (Qexit, Qt); + { + minibuffer_quit_level = minibuf_depth; + Fthrow (Qexit, Qt); + } } else Fthrow (Qexit, Qt); @@ -508,6 +536,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object mini_frame, ambient_dir, minibuffer, input_method; Lisp_Object calling_frame = selected_frame; + Lisp_Object calling_window = selected_window; Lisp_Object enable_multibyte; EMACS_INT pos = 0; /* String to add to the history. */ @@ -598,7 +627,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, if (minibuf_level > 1 && minibuf_moves_frame_when_opened () - && !minibuf_follows_frame ()) + && (!minibuf_follows_frame () + || (!EQ (mini_frame, selected_frame)))) { EMACS_INT i; @@ -607,8 +637,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, set_window_buffer (minibuf_window, nth_minibuffer (i), 0, 0); } - record_unwind_protect_void (choose_minibuf_frame); - record_unwind_protect (restore_window_configuration, Fcons (Qt, Fcurrent_window_configuration (Qnil))); @@ -640,7 +668,9 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, minibuf_save_list = Fcons (Voverriding_local_map, Fcons (minibuf_window, - minibuf_save_list)); + Fcons (calling_frame, + Fcons (calling_window, + minibuf_save_list)))); minibuf_save_list = Fcons (minibuf_prompt, Fcons (make_fixnum (minibuf_prompt_width), @@ -694,6 +724,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* Switch to the minibuffer. */ minibuffer = get_minibuffer (minibuf_level); + set_minibuffer_mode (minibuffer, minibuf_level); Fset_buffer (minibuffer); /* Defeat (setq-default truncate-lines t), since truncated lines do @@ -738,6 +769,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, where there is an active minibuffer. Set them to point to ` *Minibuf-0*', which is always empty. */ empty_minibuf = get_minibuffer (0); + set_minibuffer_mode (empty_minibuf, 0); FOR_EACH_FRAME (dummy, frame) { @@ -837,20 +869,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, recursive_edit_1 (); - /* We've exited the recursive edit without an error, so switch the - current window away from the expired minibuffer window. */ - { - Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil); - /* PREV can be on a different frame when we have a minibuffer only - frame, the other frame's minibuffer window is MINIBUF_WINDOW, - and its "focus window" is also MINIBUF_WINDOW. */ - while (!EQ (prev, minibuf_window) - && !EQ (selected_frame, WINDOW_FRAME (XWINDOW (prev)))) - prev = Fprevious_window (prev, Qnil, Qnil); - if (!EQ (prev, minibuf_window)) - Fset_frame_selected_window (selected_frame, prev, Qnil); - } - /* If cursor is on the minibuffer line, show the user we have exited by putting it in column 0. */ if (XWINDOW (minibuf_window)->cursor.vpos >= 0 @@ -959,11 +977,16 @@ Lisp_Object get_minibuffer (EMACS_INT depth) { Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list); + Lisp_Object cll_tail = Fnthcdr (make_fixnum (depth), + Vcommand_loop_level_list); if (NILP (tail)) { tail = list1 (Qnil); Vminibuffer_list = nconc2 (Vminibuffer_list, tail); + cll_tail = list1 (Qnil); + Vcommand_loop_level_list = nconc2 (Vcommand_loop_level_list, cll_tail); } + XSETCAR (cll_tail, make_fixnum (depth ? command_loop_level : 0)); Lisp_Object buf = Fcar (tail); if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf))) { @@ -973,7 +996,6 @@ get_minibuffer (EMACS_INT depth) buf = Fget_buffer_create (lname, Qnil); /* Do this before set_minibuffer_mode. */ XSETCAR (tail, buf); - set_minibuffer_mode (buf, depth); /* Although the buffer's name starts with a space, undo should be enabled in it. */ Fbuffer_enable_undo (buf); @@ -985,12 +1007,19 @@ get_minibuffer (EMACS_INT depth) while the buffer doesn't know about them any more. */ delete_all_overlays (XBUFFER (buf)); reset_buffer (XBUFFER (buf)); - set_minibuffer_mode (buf, depth); } return buf; } +static EMACS_INT minibuf_c_loop_level (EMACS_INT depth) +{ + Lisp_Object cll = Fnth (make_fixnum (depth), Vcommand_loop_level_list); + if (FIXNUMP (cll)) + return XFIXNUM (cll); + return 0; +} + static void run_exit_minibuf_hook (void) { @@ -1004,17 +1033,16 @@ static void read_minibuf_unwind (void) { Lisp_Object old_deactivate_mark; - Lisp_Object window; + Lisp_Object calling_frame; + Lisp_Object calling_window; Lisp_Object future_mini_window; - /* If this was a recursive minibuffer, - tie the minibuffer window back to the outer level minibuffer buffer. */ - minibuf_level--; - - window = minibuf_window; /* To keep things predictable, in case it matters, let's be in the - minibuffer when we reset the relevant variables. */ - Fset_buffer (XWINDOW (window)->contents); + minibuffer when we reset the relevant variables. Don't depend on + `minibuf_window' here. This could by now be the mini-window of any + frame. */ + Fset_buffer (nth_minibuffer (minibuf_level)); + minibuf_level--; /* Restore prompt, etc, from outer minibuffer level. */ Lisp_Object key_vec = Fcar (minibuf_save_list); @@ -1042,6 +1070,10 @@ read_minibuf_unwind (void) #endif future_mini_window = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); + calling_frame = Fcar (minibuf_save_list); + minibuf_save_list = Fcdr (minibuf_save_list); + calling_window = Fcar (minibuf_save_list); + minibuf_save_list = Fcdr (minibuf_save_list); /* Erase the minibuffer we were using at this level. */ { @@ -1059,7 +1091,7 @@ read_minibuf_unwind (void) mini-window back to its normal size. */ if (minibuf_level == 0 || !EQ (selected_frame, WINDOW_FRAME (XWINDOW (future_mini_window)))) - resize_mini_window (XWINDOW (window), 0); + resize_mini_window (XWINDOW (minibuf_window), 0); /* Deal with frames that should be removed when exiting the minibuffer. */ @@ -1090,6 +1122,24 @@ read_minibuf_unwind (void) to make sure we don't leave around bindings and stuff which only made sense during the read_minibuf invocation. */ call0 (intern ("minibuffer-inactive-mode")); + + /* We've exited the recursive edit, so switch the current windows + away from the expired minibuffer window, both in the current + minibuffer's frame and the original calling frame. */ + choose_minibuf_frame (); + if (!EQ (WINDOW_FRAME (XWINDOW (minibuf_window)), calling_frame)) + { + Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil); + /* PREV can be on a different frame when we have a minibuffer only + frame, the other frame's minibuffer window is MINIBUF_WINDOW, + and its "focus window" is also MINIBUF_WINDOW. */ + if (!EQ (prev, minibuf_window) + && EQ (WINDOW_FRAME (XWINDOW (prev)), + WINDOW_FRAME (XWINDOW (minibuf_window)))) + Fset_frame_selected_window (selected_frame, prev, Qnil); + } + else + Fset_frame_selected_window (calling_frame, calling_window, Qnil); } @@ -2137,6 +2187,7 @@ void init_minibuf_once (void) { staticpro (&Vminibuffer_list); + staticpro (&Vcommand_loop_level_list); pdumper_do_now_and_after_load (init_minibuf_once_for_pdumper); } @@ -2150,6 +2201,7 @@ init_minibuf_once_for_pdumper (void) restore from a dump file. pdumper doesn't try to preserve frames, windows, and so on, so reset everything related here. */ Vminibuffer_list = Qnil; + Vcommand_loop_level_list = Qnil; minibuf_level = 0; minibuf_prompt = Qnil; minibuf_save_list = Qnil; @@ -2380,6 +2432,7 @@ instead. */); defsubr (&Sminibufferp); defsubr (&Sinnermost_minibuffer_p); + defsubr (&Sminibuffer_innermost_command_loop_p); defsubr (&Sabort_minibuffers); defsubr (&Sminibuffer_prompt_end); defsubr (&Sminibuffer_contents); diff --git a/src/window.h b/src/window.h index 79eb44e7a38..b6f88e8f55f 100644 --- a/src/window.h +++ b/src/window.h @@ -1120,10 +1120,6 @@ void set_window_buffer (Lisp_Object window, Lisp_Object buffer, extern Lisp_Object echo_area_window; -/* Depth in recursive edits. */ - -extern EMACS_INT command_loop_level; - /* Non-zero if we should redraw the mode lines on the next redisplay. Usually set to a unique small integer so we can track the main causes of full redisplays in `redisplay--mode-lines-cause'. */ From 9451ea0a05612ec95a01c8c0b28d851176ed8b43 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 11 Feb 2021 18:54:12 -0500 Subject: [PATCH 134/297] * lisp/cedet/semantic/decorate/: Use lexical-binding in all files * lisp/cedet/semantic/decorate/include.el (semantic-decoration-fileless-include-describe): Remove unused var `mm`. * lisp/cedet/semantic/decorate/mode.el: Use lexical-binding. --- lisp/cedet/semantic/decorate/include.el | 8 ++++---- lisp/cedet/semantic/decorate/mode.el | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index ee7fad1fc5f..851a2c46a9e 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -1,4 +1,4 @@ -;;; semantic/decorate/include.el --- Decoration modes for include statements +;;; semantic/decorate/include.el --- Decoration modes for include statements -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -535,7 +535,7 @@ Argument EVENT is the mouse clicked event." (interactive) (let* ((tag (semantic-current-tag)) (table (semanticdb-find-table-for-include tag (current-buffer))) - (mm major-mode)) + ) ;; (mm major-mode) (with-output-to-temp-buffer (help-buffer) ; "*Help*" (help-setup-xref (list #'semantic-decoration-fileless-include-describe) (called-interactively-p 'interactive)) @@ -793,7 +793,7 @@ any decorated referring includes.") (let ((table (oref obj table))) ;; This is a hack. Add in something better? (semanticdb-notify-references - table (lambda (tab me) + table (lambda (tab _me) (semantic-decoration-unparsed-include-refrence-reset tab) )) )) @@ -805,7 +805,7 @@ any decorated referring includes.") (semantic-reset cache))) (cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache) - new-tags) + _new-tags) "Synchronize a CACHE with some NEW-TAGS." (semantic-reset cache)) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 884b066d77f..89cc9304d47 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -1,4 +1,4 @@ -;;; semantic/decorate/mode.el --- Minor mode for decorating tags +;;; semantic/decorate/mode.el --- Minor mode for decorating tags -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc. @@ -358,12 +358,12 @@ Return non-nil if the decoration style is enabled." :selected `(semantic-decoration-style-enabled-p ,(car style)) )) -(defun semantic-build-decoration-mode-menu (&rest ignore) +(defun semantic-build-decoration-mode-menu (&rest _ignore) "Create a menu listing all the known decorations for toggling. IGNORE any input arguments." (or semantic-decoration-menu-cache (setq semantic-decoration-menu-cache - (mapcar 'semantic-decoration-build-style-menu + (mapcar #'semantic-decoration-build-style-menu (reverse semantic-decoration-styles)) ))) From c55f4055dd28452996d828ee1a65b29c1ddce4c8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 11 Feb 2021 19:00:53 -0500 Subject: [PATCH 135/297] * lisp/cedet/semantic/symref/: Use lexical-binding * lisp/cedet/semantic/symref/cscope.el: * lisp/cedet/semantic/symref/filter.el: * lisp/cedet/semantic/symref/global.el: * lisp/cedet/semantic/symref/grep.el: * lisp/cedet/semantic/symref/idutils.el: * lisp/cedet/semantic/symref/list.el: Use lexical-binding. --- lisp/cedet/semantic/symref/cscope.el | 4 ++-- lisp/cedet/semantic/symref/filter.el | 10 ++++++---- lisp/cedet/semantic/symref/global.el | 2 +- lisp/cedet/semantic/symref/grep.el | 2 +- lisp/cedet/semantic/symref/idutils.el | 4 ++-- lisp/cedet/semantic/symref/list.el | 2 +- 6 files changed, 13 insertions(+), 11 deletions(-) diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el index 3686e519460..e63b7a7e914 100644 --- a/lisp/cedet/semantic/symref/cscope.el +++ b/lisp/cedet/semantic/symref/cscope.el @@ -1,6 +1,6 @@ -;;; semantic/symref/cscope.el --- Semantic-symref support via cscope. +;;; semantic/symref/cscope.el --- Semantic-symref support via cscope -*- lexical-binding: t; -*- -;;; Copyright (C) 2009-2021 Free Software Foundation, Inc. +;; Copyright (C) 2009-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el index a40ce13f3d6..7ef3cd90d67 100644 --- a/lisp/cedet/semantic/symref/filter.el +++ b/lisp/cedet/semantic/symref/filter.el @@ -1,4 +1,4 @@ -;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy. +;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. @@ -48,7 +48,7 @@ "Determine if the tag TARGET is used at POSITION in the current buffer. Return non-nil for a match." (semantic-analyze-current-symbol - (lambda (start end prefix) + (lambda (_start _end prefix) (let ((tag (car (nreverse prefix)))) (and (semantic-tag-p tag) (semantic-equivalent-tag-p target tag)))) @@ -97,7 +97,7 @@ tag that contains point, and return that." (Lcount 0)) (when (semantic-tag-p target) (semantic-symref-hits-in-region - target (lambda (start end prefix) (setq Lcount (1+ Lcount))) + target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount))) (semantic-tag-start tag) (semantic-tag-end tag)) (when (called-interactively-p 'interactive) @@ -106,6 +106,8 @@ tag that contains point, and return that." (semantic-elapsed-time start nil))) Lcount))) +(defvar srecode-field-archive) + (defun semantic-symref-rename-local-variable () "Fancy way to rename the local variable under point. Depends on the SRecode Field editing API." @@ -140,7 +142,7 @@ Depends on the SRecode Field editing API." (region nil) ) (semantic-symref-hits-in-region - target (lambda (start end prefix) + target (lambda (start end _prefix) ;; For every valid hit, create one field. (srecode-field "LOCAL" :name "LOCAL" :start start :end end)) (semantic-tag-start tag) (semantic-tag-end tag)) diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el index 7f63e4ddbc0..23e40349a6b 100644 --- a/lisp/cedet/semantic/symref/global.el +++ b/lisp/cedet/semantic/symref/global.el @@ -1,4 +1,4 @@ -;;; semantic/symref/global.el --- Use GNU Global for symbol references +;;; semantic/symref/global.el --- Use GNU Global for symbol references -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 9f0ac38ec75..46027f1f91e 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -1,4 +1,4 @@ -;;; semantic/symref/grep.el --- Symref implementation using find/grep +;;; semantic/symref/grep.el --- Symref implementation using find/grep -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el index 4a41355dd69..3e3e3b0a940 100644 --- a/lisp/cedet/semantic/symref/idutils.el +++ b/lisp/cedet/semantic/symref/idutils.el @@ -1,6 +1,6 @@ -;;; semantic/symref/idutils.el --- Symref implementation for idutils +;;; semantic/symref/idutils.el --- Symref implementation for idutils -*- lexical-binding: t; -*- -;;; Copyright (C) 2009-2021 Free Software Foundation, Inc. +;; Copyright (C) 2009-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 7d3a5ddc2dc..50d2e2b1c3e 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -1,4 +1,4 @@ -;;; semantic/symref/list.el --- Symref Output List UI. +;;; semantic/symref/list.el --- Symref Output List UI -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. From 3a4b65177f0c26f342e657636ce62e8c16cbb14b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 11 Feb 2021 19:06:30 -0500 Subject: [PATCH 136/297] * lisp/emacs-lisp/gv.el (gv-place): Simplify --- lisp/emacs-lisp/gv.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 29f8230e6b8..c160aa1fd35 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -307,7 +307,7 @@ The return value is the last VAL in the list. ;; Autoload this `put' since a user might use C-u C-M-x on an expression ;; containing a non-trivial `push' even before gv.el was loaded. ;;;###autoload -(put 'gv-place 'edebug-form-spec 'edebug-match-form) +(put 'gv-place 'edebug-form-spec '(form)) ;So-called "indirect spec". ;; CL did the equivalent of: ;;(gv-define-macroexpand edebug-after (lambda (before index place) place)) From da64a257a482e95a3a314da97260ea08635a83e0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 12 Feb 2021 09:25:13 +0200 Subject: [PATCH 137/297] ; * CONTRIBUTE: Yet another clarification of significant changes. --- CONTRIBUTE | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 9f0d9e7e164..b7d72f9965e 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -66,12 +66,15 @@ more reliably, and makes the job of applying the patches easier and less error-prone. It also allows sending patches whose author is someone other than the email sender. -Once the cumulative amount of your submissions exceeds about 15 lines -of non-trivial code you added or changed (not counting deleted lines), -we will need you to assign to the FSF the copyright for your -contributions. Ask on emacs-devel@gnu.org, and we will send you the -necessary form together with the instructions to fill and email it, in -order to start this legal paperwork. +Once the cumulative amount of your submissions exceeds about 10 lines +of non-trivial changes, we will need you to assign to the FSF the +copyright for your contributions. (To see how many lines were +non-trivially changed, count only added and modified lines in the +patched code. Consider an added or changed line non-trivial if it +includes at least one identifier, string, or substantial comment.) +Ask on emacs-devel@gnu.org, and we will send you the necessary form +together with the instructions to fill and email it, in order to start +this legal paperwork. ** Issue tracker (a.k.a. "bug tracker") From 6a2cdc67fa7607d5f77aee053a62773533cd5e7b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 12 Feb 2021 14:19:50 +0100 Subject: [PATCH 138/297] Allow minor modes to specify major modes they're useful in --- doc/lispref/modes.texi | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index ce7727b87eb..3c64e97b3b9 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1730,6 +1730,11 @@ and @var{set} is a function of one argument (a state) that sets it. @item :after-hook @var{after-hook} This defines a single Lisp form which is evaluated after the mode hooks have run. It should not be quoted. + +@item :interactive @var{value} +Minor modes are interactive commands by default. If @var{value} is +@code{nil}, this is inhibited. If @var{value} is a list of symbols, +it's used to say which major modes this minor mode is useful in. @end table Any other keyword arguments are passed directly to the From db237850abc240e2c3e765e9cc7e15ee5681dcaf Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Fri, 12 Feb 2021 11:43:02 +0100 Subject: [PATCH 139/297] Remove Motif support * configure.ac: Remove support for configuring --with-x-toolkit=motif * etc/NEWS: Mention removal of Motif support. --- configure.ac | 9 ++++----- etc/NEWS | 3 +++ 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/configure.ac b/configure.ac index 08f3c0cd857..12cf36303b3 100644 --- a/configure.ac +++ b/configure.ac @@ -409,19 +409,18 @@ dnl This should be the last --with option, because --with-x is dnl added later on when we find the file name of X, and it's best to dnl keep them together visually. AC_ARG_WITH([x-toolkit],[AS_HELP_STRING([--with-x-toolkit=KIT], - [use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena, motif, no)])], + [use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena, no)])], [ case "${withval}" in y | ye | yes ) val=gtk ;; n | no ) val=no ;; l | lu | luc | luci | lucid ) val=lucid ;; a | at | ath | athe | athen | athena ) val=athena ;; - m | mo | mot | moti | motif ) val=motif ;; g | gt | gtk ) val=gtk ;; gtk2 ) val=gtk2 ;; gtk3 ) val=gtk3 ;; * ) AC_MSG_ERROR(['--with-x-toolkit=$withval' is invalid; -this option's value should be 'yes', 'no', 'lucid', 'athena', 'motif', 'gtk', +this option's value should be 'yes', 'no', 'lucid', 'athena', 'gtk', 'gtk2' or 'gtk3'. 'yes' and 'gtk' are synonyms. 'athena' and 'lucid' are synonyms.]) ;; @@ -460,7 +459,7 @@ OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping]) OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support]) OPTION_DEFAULT_ON([m17n-flt],[don't use m17n-flt for text shaping]) -OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif/Xaw3d/GTK toolkit scroll bars]) +OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Xaw3d/GTK toolkit scroll bars]) OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d]) OPTION_DEFAULT_ON([xim],[at runtime, default X11 XIM to off]) OPTION_DEFAULT_ON([xdbe],[don't use X11 double buffering support]) @@ -2252,7 +2251,7 @@ if test "$window_system" = none && test "X$with_x" != "Xno"; then then AC_MSG_ERROR([You seem to be running X, but no X development libraries were found. You should install the relevant development files for X -and for the toolkit you want, such as Gtk+ or Motif. Also make +and for the toolkit you want, such as Gtk+. Also make sure you have development files for image handling, i.e. tiff, gif, jpeg, png and xpm. If you are sure you want Emacs compiled without X window support, pass diff --git a/etc/NEWS b/etc/NEWS index 2f15f078a75..9a9c75f0f8c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,6 +24,9 @@ applies, and please also update docstrings as needed. * Installation Changes in Emacs 28.1 +-- +** Support for building with Motif has been removed. + ** Cairo graphics library is now used by default if found. '--with-cairo' is now the default, if the appropriate development files are found by 'configure'. Note that building with Cairo means using From 1d2487b1fc5f0648deb80507be8c713d4482fd8d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 11:12:49 -0500 Subject: [PATCH 140/297] * lisp/emacs-lisp/edebug.el: Misc cleanups. Move all definitions under the `edebug-` prefix. (edebug-get-spec): Rename from `get-edebug-spec`. (edebug-move-cursor): Use `cl-callf`. (edebug-spec-p): Remove unused function. (def-edebug-spec, edebug-spec-list, edebug-spec): Remove unused specs (nothing in there gets instrumented anyway). (edebug-tracing): Use `declare`. (edebug-cancel-on-entry): Rename from `cancel-edebug-on-entry`. (edebug-global-prefix): Rename from `global-edebug-prefix`. (edebug-global-map): Rename from `global-edebug-map`. * lisp/emacs-lisp/pcase.el (pcase-PAT): Remove `let`. (let): Use `declare` instead. (pcase--edebug-match-macro): Use new name `edebug-get-spec`. --- etc/NEWS | 3 ++ lisp/emacs-lisp/edebug.el | 101 ++++++++++++++++++-------------------- lisp/emacs-lisp/pcase.el | 30 ++++++----- 3 files changed, 65 insertions(+), 69 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 9a9c75f0f8c..228b773cb27 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -935,6 +935,9 @@ To customize obsolete user options, use 'customize-option' or ** Edebug +--- +*** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. + +++ *** Edebug specification lists can use the new keyword '&error', which unconditionally aborts the current edebug instrumentation with the diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 0733dcec27b..04a4829c5e6 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -244,19 +244,22 @@ If the result is non-nil, then break. Errors are ignored." ;;; Form spec utilities. -(defun get-edebug-spec (symbol) +(defun edebug-get-spec (symbol) + "Return the Edebug spec of a given Lisp expression's head SYMBOL. +The argument is usually a symbol, but it doesn't have to be." ;; Get the spec of symbol resolving all indirection. (let ((spec nil) (indirect symbol)) (while - (progn - (and (symbolp indirect) - (setq indirect - (function-get indirect 'edebug-form-spec 'macro)))) + (and (symbolp indirect) + (setq indirect + (function-get indirect 'edebug-form-spec 'macro))) ;; (edebug-trace "indirection: %s" edebug-form-spec) (setq spec indirect)) spec)) +(define-obsolete-function-alias 'get-edebug-spec #'edebug-get-spec "28.1") + ;;;###autoload (defun edebug-basic-spec (spec) "Return t if SPEC uses only extant spec symbols. @@ -961,6 +964,18 @@ circular objects. Let `read' read everything else." ;;; Cursors for traversal of list and vector elements with offsets. +;; Edebug's instrumentation is based on parsing the sexps, which come with +;; auxiliary position information. Instead of keeping the position +;; information together with the sexps, it is kept in a "parallel +;; tree" of offsets. +;; +;; An "edebug cursor" is a pair of a *list of sexps* (called the +;; "expressions") together with a matching list of offsets. +;; When we're parsing the content of a list, the +;; `edebug-cursor-expressions' is simply the list but when parsing +;; a vector, the `edebug-cursor-expressions' is a list formed of the +;; elements of the vector. + (defvar edebug-dotted-spec nil "Set to t when matching after the dot in a dotted spec list.") @@ -1015,8 +1030,8 @@ circular objects. Let `read' read everything else." ;; The following test should always fail. (if (edebug-empty-cursor cursor) (edebug-no-match cursor "Not enough arguments.")) - (setcar cursor (cdr (car cursor))) - (setcdr cursor (cdr (cdr cursor))) + (cl-callf cdr (car cursor)) + (cl-callf cdr (cdr cursor)) cursor) @@ -1153,7 +1168,7 @@ purpose by adding an entry to this alist, and setting (eq 'symbol (progn (forward-char 1) (edebug-next-token-class)))) ;; Find out if this is a defining form from first symbol (setq def-kind (read (current-buffer)) - spec (and (symbolp def-kind) (get-edebug-spec def-kind)) + spec (and (symbolp def-kind) (edebug-get-spec def-kind)) defining-form-p (and (listp spec) (eq '&define (car spec))) ;; This is incorrect in general!! But OK most of the time. @@ -1502,7 +1517,7 @@ contains a circular object." (if (eq 'quote (car form)) form (let* ((head (car form)) - (spec (and (symbolp head) (get-edebug-spec head))) + (spec (and (symbolp head) (edebug-get-spec head))) (new-cursor (edebug-new-cursor form offset))) ;; Find out if this is a defining form from first symbol. ;; An indirect spec would not work here, yet. @@ -1542,7 +1557,7 @@ contains a circular object." (defsubst edebug-list-form-args (head cursor) ;; Process the arguments of a list form given that head of form is a symbol. ;; Helper for edebug-list-form - (let ((spec (get-edebug-spec head))) + (let ((spec (edebug-get-spec head))) (cond ;; Treat cl-macrolet bindings like macros with no spec. ((member head edebug--cl-macrolet-defs) @@ -1645,7 +1660,7 @@ contains a circular object." edebug-error-point (edebug-gate edebug-gate) ;; locally bound to limit effect ) - (edebug-match-specs cursor specs 'edebug-match-specs))) + (edebug-match-specs cursor specs #'edebug-match-specs))) (defun edebug-match-one-spec (cursor spec) @@ -1741,11 +1756,16 @@ contains a circular object." (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. )) + ;; FIXME: We abuse `edebug-form-spec' here. It's normally used to store the + ;; specs for a given sexp's head, but here we use it to keep the + ;; function implementing of a given "core spec". (put (car pair) 'edebug-form-spec (cdr pair))) (defun edebug-match-symbol (cursor symbol) ;; Match a symbol spec. - (let* ((spec (get-edebug-spec symbol))) + ;; FIXME: We abuse `edebug-get-spec' here, passing it a *spec* rather than + ;; the head element of a source sexp. + (let* ((spec (edebug-get-spec symbol))) (cond (spec (if (consp spec) @@ -2000,7 +2020,7 @@ contains a circular object." cursor "Expected lambda expression")) (offset (edebug-top-offset cursor)) (head (and (consp sexp) (car sexp))) - (spec (and (symbolp head) (get-edebug-spec head))) + (spec (and (symbolp head) (edebug-get-spec head))) (edebug-inside-func nil)) ;; Find out if this is a defining form from first symbol. (if (and (consp spec) (eq '&define (car spec))) @@ -2145,37 +2165,6 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." ;;;; Edebug Form Specs ;;; ========================================================== -;;;;* Spec for def-edebug-spec -;;; Out of date. - -(defun edebug-spec-p (object) - "Return non-nil if OBJECT is a symbol with an edebug-form-spec property." - (and (symbolp object) - (get object 'edebug-form-spec))) - -(def-edebug-spec def-edebug-spec - ;; Top level is different from lower levels. - (&define :name edebug-spec name - &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec))) - -(def-edebug-spec edebug-spec-list - ;; A list must have something in it, or it is nil, a symbolp - ((edebug-spec . [&or nil edebug-spec]))) - -(def-edebug-spec edebug-spec - (&or - edebug-spec-list - (vector &rest edebug-spec) ; matches a vector - ("vector" &rest edebug-spec) ; matches a vector spec - ("quote" symbolp) - stringp - [edebug-lambda-list-keywordp &rest edebug-spec] - [keywordp gate edebug-spec] - edebug-spec-p ;; Including all the special ones e.g. form. - symbolp;; a predicate - )) - - ;;;* Emacs special forms and some functions. ;; quote expects only one argument, although it allows any number. @@ -2485,11 +2474,10 @@ STATUS should be a list returned by `edebug-var-status'." (edebug-print-trace-after (format "%s result: %s" function edebug-result))))) -(def-edebug-spec edebug-tracing (form body)) - (defmacro edebug-tracing (msg &rest body) "Print MSG in *edebug-trace* before and after evaluating BODY. The result of BODY is also printed." + (declare (debug (form body))) `(let ((edebug-stack-depth (1+ edebug-stack-depth)) edebug-result) (edebug-print-trace-before ,msg) @@ -3601,7 +3589,10 @@ canceled the first time the function is entered." ;; Could store this in the edebug data instead. (put function 'edebug-on-entry (if flag 'temp t))) -(defalias 'edebug-cancel-edebug-on-entry #'cancel-edebug-on-entry) +(define-obsolete-function-alias 'edebug-cancel-edebug-on-entry + #'edebug-cancel-on-entry "28.1") +(define-obsolete-function-alias 'cancel-edebug-on-entry + #'edebug-cancel-on-entry "28.1") (defun edebug--edebug-on-entry-functions () (let ((functions nil)) @@ -3613,7 +3604,7 @@ canceled the first time the function is entered." obarray) functions)) -(defun cancel-edebug-on-entry (function) +(defun edebug-cancel-on-entry (function) "Cause Edebug to not stop when FUNCTION is called. The removes the effect of `edebug-on-entry'. If FUNCTION is is nil, remove `edebug-on-entry' on all functions." @@ -3937,10 +3928,14 @@ be installed in `emacs-lisp-mode-map'.") ;; Autoloading these global bindings doesn't make sense because ;; they cannot be used anyway unless Edebug is already loaded and active. -(defvar global-edebug-prefix "\^XX" +(define-obsolete-variable-alias 'global-edebug-prefix + 'edebug-global-prefix "28.1") +(defvar edebug-global-prefix "\^XX" "Prefix key for global edebug commands, available from any buffer.") -(defvar global-edebug-map +(define-obsolete-variable-alias 'global-edebug-map + 'edebug-global-map "28.1") +(defvar edebug-global-map (let ((map (make-sparse-keymap))) (define-key map " " 'edebug-step-mode) @@ -3973,9 +3968,9 @@ be installed in `emacs-lisp-mode-map'.") map) "Global map of edebug commands, available from any buffer.") -(when global-edebug-prefix - (global-unset-key global-edebug-prefix) - (global-set-key global-edebug-prefix global-edebug-map)) +(when edebug-global-prefix + (global-unset-key edebug-global-prefix) + (global-set-key edebug-global-prefix edebug-global-map)) (defun edebug-help () diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index ec746fa4747..7a88bdf8de5 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -27,19 +27,10 @@ ;; Todo: -;; - (pcase e (`(,x . ,x) foo)) signals an "x unused" warning if `foo' doesn't -;; use x, because x is bound separately for the equality constraint -;; (as well as any pred/guard) and for the body, so uses at one place don't -;; count for the other. -;; - provide ways to extend the set of primitives, with some kind of -;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP) -;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)). -;; But better would be if we could define new ways to match by having the -;; extension provide its own `pcase--split-' thingy. -;; - along these lines, provide patterns to match CL structs. +;; - Allow to provide new `pcase--split-' thingy. ;; - provide something like (setq VAR) so a var can be set rather than ;; let-bound. -;; - provide a way to fallthrough to subsequent cases +;; - provide a way to continue matching to subsequent cases ;; (e.g. Like Racket's (=> ID). ;; - try and be more clever to reduce the size of the decision tree, and ;; to reduce the number of leaves that need to be turned into functions: @@ -77,7 +68,6 @@ ("or" &rest pcase-PAT) ("and" &rest pcase-PAT) ("guard" form) - ("let" pcase-PAT form) ("pred" pcase-FUN) ("app" pcase-FUN pcase-PAT) pcase-MACRO @@ -91,10 +81,10 @@ sexp)) ;; See bug#24717 -(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro) +(put 'pcase-MACRO 'edebug-form-spec #'pcase--edebug-match-macro) ;; Only called from edebug. -(declare-function get-edebug-spec "edebug" (symbol)) +(declare-function edebug-get-spec "edebug" (symbol)) (declare-function edebug-match "edebug" (cursor specs)) (defun pcase--get-macroexpander (s) @@ -106,13 +96,15 @@ (mapatoms (lambda (s) (let ((m (pcase--get-macroexpander s))) - (when (and m (get-edebug-spec m)) - (push (cons (symbol-name s) (get-edebug-spec m)) + (when (and m (edebug-get-spec m)) + (push (cons (symbol-name s) (edebug-get-spec m)) specs))))) (edebug-match cursor (cons '&or specs)))) ;;;###autoload (defmacro pcase (exp &rest cases) + ;; FIXME: Add some "global pattern" to wrap every case? + ;; Could be used to wrap all cases in a ` "Evaluate EXP to get EXPVAL; try passing control to one of CASES. CASES is a list of elements of the form (PATTERN CODE...). For the first CASE whose PATTERN \"matches\" EXPVAL, @@ -1002,7 +994,13 @@ The predicate is the logical-AND of: (pcase-defmacro let (pat expr) "Matches if EXPR matches PAT." + (declare (debug (pcase-PAT form))) `(app (lambda (_) ,expr) ,pat)) +;; (pcase-defmacro guard (expr) +;; "Matches if EXPR is non-nil." +;; (declare (debug (form))) +;; `(pred (lambda (_) ,expr))) + (provide 'pcase) ;;; pcase.el ends here From 6ae731e04f261b9139fbe3573822a381dc3577d3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 11:37:49 -0500 Subject: [PATCH 141/297] * lisp/emacs-lisp/cl-macs.el (cl-flet): Fix edebug spec --- lisp/emacs-lisp/cl-macs.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c2bf02ccece..c312afe55b9 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2016,7 +2016,7 @@ info node `(cl) Function Bindings' for details. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) - (debug ((&rest [&or (&define name :unique "cl-flet@" function-form) + (debug ((&rest [&or (&define name :unique "cl-flet@" form) (&define name :unique "cl-flet@" cl-lambda-list cl-declarations-or-string From c7b35ea3060b90ed68a933eed29e85dd2d567e3e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 12:17:40 -0500 Subject: [PATCH 142/297] * lisp/emacs-lisp/edebug.el (edebug--handle-&-spec-op) <&lookup>: New method * doc/lispref/edebug.texi (Specification List): Document it. * lisp/emacs-lisp/pcase.el (pcase-PAT): Use it. (pcase-MACRO): Remove Edebug element. (pcase--get-edebug-spec): New function. (pcase--edebug-match-macro): Remove function. --- doc/lispref/edebug.texi | 11 +++++++++++ etc/NEWS | 17 ++++++++++------- lisp/emacs-lisp/edebug.el | 17 +++++++++++++++++ lisp/emacs-lisp/pcase.el | 40 +++++++++++++-------------------------- 4 files changed, 51 insertions(+), 34 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 569545d83f1..693d0e0630a 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1370,6 +1370,17 @@ is primarily used to generate more specific syntax error messages. See edebug-spec; it aborts the instrumentation, displaying the message in the minibuffer. +@item &lookup +Selects a specification based on the code being instrumented. +It takes the form @code{&lookup @var{spec} @var{fun} @var{args...}} +and means that Edebug will first match @var{spec} against the code and +then match the rest against the specification returned by calling +@var{fun} with the concatenation of @var{args...} and the code that +matched @code{spec}. For example @code{(&lookup symbolp +pcase--get-edebug-spec)} matches sexps whose first element is +a symbol and whose subsequent elements must obey the spec associated +with that head symbol according to @code{pcase--get-edebug-spec}. + @item @var{other-symbol} @cindex indirect specifications Any other symbol in a specification list may be a predicate or an diff --git a/etc/NEWS b/etc/NEWS index 228b773cb27..fe626fec7ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -938,14 +938,17 @@ To customize obsolete user options, use 'customize-option' or --- *** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. -+++ -*** Edebug specification lists can use the new keyword '&error', which -unconditionally aborts the current edebug instrumentation with the -supplied error message. +*** Edebug specification lists can use some new keywords: -*** Edebug specification lists can use the new keyword ':unique', -which appends a unique suffix to the Edebug name of the current -definition. ++++ +**** '&lookup SPEC FUN ARGS...' lets FUN compute the specs to use + ++++ +**** '&error MSG' unconditionally aborts the current edebug instrumentation. + ++++ +**** ':unique STRING' appends STRING to the Edebug name of the current +definition to (hopefully) make it more unique. ** ElDoc diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 04a4829c5e6..782299454ea 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -55,6 +55,7 @@ (require 'backtrace) (require 'macroexp) (require 'cl-lib) +(require 'seq) (eval-when-compile (require 'pcase)) ;;; Options @@ -1866,6 +1867,22 @@ contains a circular object." (apply #'edebug-no-match cursor "Expected one of" original-specs)) )) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &lookup)) cursor specs) + "Compute the specs for `&lookup SPEC FUN ARGS...'. +Extracts the head of the data by matching it against SPEC, +and then matches the rest against the output of (FUN ARGS... HEAD)." + (pcase-let* + ((`(,spec ,fun . ,args) specs) + (exps (edebug-cursor-expressions cursor)) + (instrumented-head (edebug-match-one-spec cursor (or spec 'sexp))) + (consumed (- (length exps) + (length (edebug-cursor-expressions cursor)))) + (newspecs (apply fun (append args (seq-subseq exps 0 consumed))))) + (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps))) + ;; FIXME: What'd be the difference if we used `edebug-match-sublist', + ;; which is what `edebug-list-form-args' uses for the similar purpose + ;; when matching "normal" forms? + (append instrumented-head (edebug-match cursor newspecs)))) (cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs) ;; If any specs match, then fail diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7a88bdf8de5..d6c96c1ec82 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -62,45 +62,32 @@ (defvar pcase--dontwarn-upats '(pcase--dontcare)) -(def-edebug-spec - pcase-PAT - (&or symbolp - ("or" &rest pcase-PAT) - ("and" &rest pcase-PAT) - ("guard" form) - ("pred" pcase-FUN) - ("app" pcase-FUN pcase-PAT) - pcase-MACRO +(def-edebug-spec pcase-PAT + (&or (&lookup symbolp pcase--get-edebug-spec) sexp)) -(def-edebug-spec - pcase-FUN +(def-edebug-spec pcase-FUN (&or lambda-expr ;; Punt on macros/special forms. (functionp &rest form) sexp)) -;; See bug#24717 -(put 'pcase-MACRO 'edebug-form-spec #'pcase--edebug-match-macro) - ;; Only called from edebug. (declare-function edebug-get-spec "edebug" (symbol)) -(declare-function edebug-match "edebug" (cursor specs)) +(defun pcase--get-edebug-spec (head) + (or (alist-get head '((quote sexp) + (or &rest pcase-PAT) + (and &rest pcase-PAT) + (guard form) + (pred &or ("not" pcase-FUN) pcase-FUN) + (app pcase-FUN pcase-PAT))) + (let ((me (pcase--get-macroexpander head))) + (and me (symbolp me) (edebug-get-spec me))))) (defun pcase--get-macroexpander (s) "Return the macroexpander for pcase pattern head S, or nil" (get s 'pcase-macroexpander)) -(defun pcase--edebug-match-macro (cursor) - (let (specs) - (mapatoms - (lambda (s) - (let ((m (pcase--get-macroexpander s))) - (when (and m (edebug-get-spec m)) - (push (cons (symbol-name s) (edebug-get-spec m)) - specs))))) - (edebug-match cursor (cons '&or specs)))) - ;;;###autoload (defmacro pcase (exp &rest cases) ;; FIXME: Add some "global pattern" to wrap every case? @@ -938,8 +925,7 @@ Otherwise, it defers to REST which is a list of branches of the form (t (error "Unknown pattern `%S'" upat))))) (t (error "Incorrect MATCH %S" (car matches))))) -(def-edebug-spec - pcase-QPAT +(def-edebug-spec pcase-QPAT ;; Cf. edebug spec for `backquote-form' in edebug.el. (&or ("," pcase-PAT) (pcase-QPAT [&rest [¬ ","] pcase-QPAT] From 506b8d725a4591747a97e806c140d9e72863c1d0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 12 Feb 2021 05:15:01 +0100 Subject: [PATCH 143/297] Add font locking for many missing macros in m4-mode * lisp/progmodes/m4-mode.el (m4--macro-list): New variable. (m4-font-lock-keywords): Use regexp-opt and add many missing macros sourced from the M4 manual. --- lisp/progmodes/m4-mode.el | 50 +++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index 99f4be38721..431d86bddd2 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -60,12 +60,34 @@ If m4 is not in your PATH, set this to an absolute file name." ;;or ;;(defconst m4-program-options '("--prefix-builtins")) +;; Needed at compile-time for `m4-font-lock-keywords' below. +(eval-and-compile + (defconst m4--macro-list + ;; From (info "(m4) Macro index") + '("__file__" "__gnu__" "__line__" "__os2__" "__program__" "__unix__" + "__windows__" "argn" "array" "array_set" "builtin" "capitalize" + "changecom" "changequote" "changeword" "cleardivert" "cond" "copy" + "curry" "debugfile" "debugmode" "decr" "define" "define_blind" + "defn" "divert" "divnum" "dnl" "downcase" "dquote" "dquote_elt" + "dumpdef" "errprint" "esyscmd" "eval" "example" "exch" + "fatal_error" "file" "foreach" "foreachq" "forloop" "format" "gnu" + "ifdef" "ifelse" "include" "incr" "index" "indir" "join" "joinall" + "len" "line" "m4exit" "m4wrap" "maketemp" "mkstemp" "nargs" "os2" + "patsubst" "popdef" "pushdef" "quote" "regexp" "rename" "reverse" + "shift" "sinclude" "stack_foreach" "stack_foreach_lifo" + "stack_foreach_sep" "stack_foreach_sep_lifo" "substr" "syscmd" + "sysval" "traceoff" "traceon" "translit" "undefine" "undivert" + "unix" "upcase" "windows") + "List of valid m4 macros. for M4 mode")) + (defvar m4-font-lock-keywords - '(("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" (0 font-lock-comment-face t)) - ("\\$[*#@0-9]" . font-lock-variable-name-face) - ("\\$@" . font-lock-variable-name-face) - ("\\$\\*" . font-lock-variable-name-face) - ("\\_<\\(m4_\\)?\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|ivert\\)\\|ix\\)\\)\\_>" . font-lock-keyword-face)) + (eval-when-compile + `(("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" (0 font-lock-comment-face t)) + ("\\$[*#@0-9]" . font-lock-variable-name-face) + ("\\$@" . font-lock-variable-name-face) + ("\\$\\*" . font-lock-variable-name-face) + (,(concat "\\_<\\(m4_\\)?" (regexp-opt m4--macro-list) "\\_>") + . font-lock-keyword-face))) "Default `font-lock-keywords' for M4 mode.") (defcustom m4-mode-hook nil @@ -155,22 +177,4 @@ If m4 is not in your PATH, set this to an absolute file name." ;;stuff to play with for debugging ;(char-to-string (char-syntax ?`)) -;;;how I generate the nasty looking regexps at the top -;;;(make-regexp '("builtin" "changecom" "changequote" "changeword" "debugfile" -;;; "debugmode" "decr" "define" "defn" "divert" "divnum" "dnl" -;;; "dumpdef" "errprint" "esyscmd" "eval" "file" "format" "gnu" -;;; "ifdef" "ifelse" "include" "incr" "index" "indir" "len" "line" -;;; "m4exit" "m4wrap" "maketemp" "patsubst" "popdef" "pushdef" "regexp" -;;; "shift" "sinclude" "substr" "syscmd" "sysval" "traceoff" "traceon" -;;; "translit" "undefine" "undivert" "unix")) -;;;(make-regexp '("m4_builtin" "m4_changecom" "m4_changequote" "m4_changeword" -;;; "m4_debugfile" "m4_debugmode" "m4_decr" "m4_define" "m4_defn" -;;; "m4_divert" "m4_divnum" "m4_dnl" "m4_dumpdef" "m4_errprint" -;;; "m4_esyscmd" "m4_eval" "m4_file" "m4_format" "m4_ifdef" "m4_ifelse" -;;; "m4_include" "m4_incr" "m4_index" "m4_indir" "m4_len" "m4_line" -;;; "m4_m4exit" "m4_m4wrap" "m4_maketemp" "m4_patsubst" "m4_popdef" -;;; "m4_pushdef" "m4_regexp" "m4_shift" "m4_sinclude" "m4_substr" -;;; "m4_syscmd" "m4_sysval" "m4_traceoff" "m4_traceon" "m4_translit" -;;; "m4_m4_undefine" "m4_undivert")) - ;;; m4-mode.el ends here From a799f6d9d859163f8c66b1b349206141b318a9eb Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 12 Feb 2021 05:30:32 +0100 Subject: [PATCH 144/297] Minor cleanups in scheme.el * lisp/progmodes/scheme.el: Remove redundant :group args. (dsssl-font-lock-keywords): Use regexp-opt. --- lisp/progmodes/scheme.el | 25 +++++++++---------------- 1 file changed, 9 insertions(+), 16 deletions(-) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index f610efbfca5..a899de7e594 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -215,8 +215,7 @@ Blank lines separate paragraphs. Semicolons start comments. (defcustom scheme-mit-dialect t "If non-nil, scheme mode is specialized for MIT Scheme. Set this to nil if you normally use another dialect." - :type 'boolean - :group 'scheme) + :type 'boolean) (defcustom dsssl-sgml-declaration " @@ -226,26 +225,22 @@ If it is defined as a string this will be inserted into an empty buffer which is in `dsssl-mode'. It is typically James Clark's style-sheet doctype, as required for Jade." :type '(choice (string :tag "Specified string") - (const :tag "None" :value nil)) - :group 'scheme) + (const :tag "None" :value nil))) (defcustom scheme-mode-hook nil "Normal hook run when entering `scheme-mode'. See `run-hooks'." - :type 'hook - :group 'scheme) + :type 'hook) (defcustom dsssl-mode-hook nil "Normal hook run when entering `dsssl-mode'. See `run-hooks'." - :type 'hook - :group 'scheme) + :type 'hook) ;; This is shared by cmuscheme and xscheme. (defcustom scheme-program-name "scheme" "Program invoked by the `run-scheme' command." - :type 'string - :group 'scheme) + :type 'string) (defvar dsssl-imenu-generic-expression ;; Perhaps this should also look for the style-sheet DTD tags. I'm @@ -429,12 +424,10 @@ that variable's value is a string." '(1 font-lock-keyword-face) '(4 font-lock-function-name-face)) (cons - (concat "(\\(" - ;; (make-regexp '("case" "cond" "else" "if" "lambda" - ;; "let" "let*" "letrec" "and" "or" "map" "with-mode")) - "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|" - "l\\(ambda\\|et\\(\\|\\*\\|rec\\)\\)\\|map\\|or\\|with-mode" - "\\)\\>") + (concat "(" (regexp-opt + '("case" "cond" "else" "if" "lambda" + "let" "let*" "letrec" "and" "or" "map" "with-mode") + 'words)) 1) ;; DSSSL syntax '("(\\(element\\|mode\\|declare-\\w+\\)\\>[ \t]*\\(\\sw+\\)" From fffe88bf623802c64518eae84cf6f3fcd16ac420 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 12 Feb 2021 05:39:44 +0100 Subject: [PATCH 145/297] Use regexp-opt for font lock defaults in meta-mode.el * lisp/progmodes/meta-mode.el: Remove redundant :group args. (meta-font-lock-keywords): Use regexp-opt. --- lisp/progmodes/meta-mode.el | 97 ++++++++++++++----------------------- 1 file changed, 36 insertions(+), 61 deletions(-) diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 9da968c8314..46b0949c133 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -109,44 +109,31 @@ "\\(def\\|let\\|mode_def\\|vardef\\)") (macro-keywords-2 "\\(primarydef\\|secondarydef\\|tertiarydef\\)") -;(make-regexp -; '("expr" "suffix" "text" "primary" "secondary" "tertiary") t) (args-keywords - (concat "\\(expr\\|primary\\|s\\(econdary\\|uffix\\)\\|" - "te\\(rtiary\\|xt\\)\\)")) -;(make-regexp -; '("boolean" "color" "numeric" "pair" "path" "pen" "picture" -; "string" "transform" "newinternal") t) + (eval-when-compile + (regexp-opt + '("expr" "suffix" "text" "primary" "secondary" "tertiary") + t))) (type-keywords - (concat "\\(boolean\\|color\\|n\\(ewinternal\\|umeric\\)\\|" - "p\\(a\\(ir\\|th\\)\\|en\\|icture\\)\\|string\\|" - "transform\\)")) -;(make-regexp -; '("for" "forever" "forsuffixes" "endfor" -; "step" "until" "upto" "downto" "thru" "within" -; "iff" "if" "elseif" "else" "fi" "exitif" "exitunless" -; "let" "def" "vardef" "enddef" "mode_def" -; "true" "false" "known" "unknown" "and" "or" "not" -; "save" "interim" "inner" "outer" "relax" -; "begingroup" "endgroup" "expandafter" "scantokens" -; "generate" "input" "endinput" "end" "bye" -; "message" "errmessage" "errhelp" "special" "numspecial" -; "readstring" "readfrom" "write") t) + (eval-when-compile + (regexp-opt + '("boolean" "color" "numeric" "pair" "path" "pen" "picture" + "string" "transform" "newinternal") + t))) (syntactic-keywords - (concat "\\(and\\|b\\(egingroup\\|ye\\)\\|" - "d\\(ef\\|ownto\\)\\|e\\(lse\\(\\|if\\)" - "\\|nd\\(\\|def\\|for\\|group\\|input\\)" - "\\|rr\\(help\\|message\\)" - "\\|x\\(it\\(if\\|unless\\)\\|pandafter\\)\\)\\|" - "f\\(alse\\|i\\|or\\(\\|ever\\|suffixes\\)\\)\\|" - "generate\\|i\\(ff?\\|n\\(ner\\|put\\|terim\\)\\)\\|" - "known\\|let\\|m\\(essage\\|ode_def\\)\\|" - "n\\(ot\\|umspecial\\)\\|o\\(r\\|uter\\)\\|" - "re\\(ad\\(from\\|string\\)\\|lax\\)\\|" - "s\\(ave\\|cantokens\\|pecial\\|tep\\)\\|" - "t\\(hru\\|rue\\)\\|" - "u\\(n\\(known\\|til\\)\\|pto\\)\\|" - "vardef\\|w\\(ithin\\|rite\\)\\)")) + (eval-when-compile + (regexp-opt + '("for" "forever" "forsuffixes" "endfor" + "step" "until" "upto" "downto" "thru" "within" + "iff" "if" "elseif" "else" "fi" "exitif" "exitunless" + "let" "def" "vardef" "enddef" "mode_def" + "true" "false" "known" "unknown" "and" "or" "not" + "save" "interim" "inner" "outer" "relax" + "begingroup" "endgroup" "expandafter" "scantokens" + "generate" "input" "endinput" "end" "bye" + "message" "errmessage" "errhelp" "special" "numspecial" + "readstring" "readfrom" "write") + t))) ) (list ;; embedded TeX code in btex ... etex @@ -463,25 +450,21 @@ If the list was changed, sort the list and remove duplicates first." (defcustom meta-indent-level 2 "Indentation of begin-end blocks in Metafont or MetaPost mode." - :type 'integer - :group 'meta-font) + :type 'integer) (defcustom meta-left-comment-regexp "%%+" "Regexp matching comments that should be placed on the left margin." - :type 'regexp - :group 'meta-font) + :type 'regexp) (defcustom meta-right-comment-regexp nil "Regexp matching comments that should be placed on the right margin." :type '(choice regexp - (const :tag "None" nil)) - :group 'meta-font) + (const :tag "None" nil))) (defcustom meta-ignore-comment-regexp "%[^%]" "Regexp matching comments whose indentation should not be touched." - :type 'regexp - :group 'meta-font) + :type 'regexp) (defcustom meta-begin-environment-regexp @@ -489,22 +472,19 @@ If the list was changed, sort the list and remove duplicates first." "def\\|for\\(\\|ever\\|suffixes\\)\\|if\\|mode_def\\|" "primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)") "Regexp matching the beginning of environments to be indented." - :type 'regexp - :group 'meta-font) + :type 'regexp) (defcustom meta-end-environment-regexp (concat "\\(end\\(char\\|def\\|f\\(ig\\|or\\)\\|gr\\(aph\\|oup\\)\\)" "\\|fi\\)") "Regexp matching the end of environments to be indented." - :type 'regexp - :group 'meta-font) + :type 'regexp) (defcustom meta-within-environment-regexp ; (concat "\\(e\\(lse\\(\\|if\\)\\|xit\\(if\\|unless\\)\\)\\)") (concat "\\(else\\(\\|if\\)\\)") "Regexp matching keywords within environments not to be indented." - :type 'regexp - :group 'meta-font) + :type 'regexp) (defun meta-comment-indent () @@ -689,14 +669,12 @@ If the list was changed, sort the list and remove duplicates first." (concat "\\(begin\\(char\\|fig\\|logochar\\)\\|def\\|mode_def\\|" "primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)") "Regexp matching beginning of defuns in Metafont or MetaPost mode." - :type 'regexp - :group 'meta-font) + :type 'regexp) (defcustom meta-end-defun-regexp (concat "\\(end\\(char\\|def\\|fig\\)\\)") "Regexp matching the end of defuns in Metafont or MetaPost mode." - :type 'regexp - :group 'meta-font) + :type 'regexp) (defun meta-beginning-of-defun (&optional arg) @@ -893,24 +871,21 @@ The environment marked is the one that contains point or follows point." (defcustom meta-mode-load-hook nil "Hook evaluated when first loading Metafont or MetaPost mode." - :type 'hook - :group 'meta-font) + :type 'hook) (make-obsolete-variable 'meta-mode-load-hook "use `with-eval-after-load' instead." "28.1") (defcustom meta-common-mode-hook nil "Hook evaluated by both `metafont-mode' and `metapost-mode'." - :type 'hook - :group 'meta-font) + :type 'hook) (defcustom metafont-mode-hook nil "Hook evaluated by `metafont-mode' after `meta-common-mode-hook'." - :type 'hook - :group 'meta-font) + :type 'hook) + (defcustom metapost-mode-hook nil "Hook evaluated by `metapost-mode' after `meta-common-mode-hook'." - :type 'hook - :group 'meta-font) + :type 'hook) From 733dfe244b44de957b0d91b7726f3e053be7000a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 12 Feb 2021 18:38:58 +0100 Subject: [PATCH 146/297] ; Fix recent regexp-opt conversion in cperl-mode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/cperl-mode.el (cperl-init-faces): Add missing identifiers found by static analysis of recent change. Thanks to Mattias Engdegård . --- lisp/progmodes/cperl-mode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index b1a49b25a32..90ccdbf00ad 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5435,7 +5435,7 @@ indentation and initial hashes. Behaves usually outside of comment." (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" (regexp-opt - '("CORE" "__FILE__" "__LINE__" "__SUB__" + '("CORE" "__FILE__" "__LINE__" "__SUB__" "__PACKAGE__" "abs" "accept" "alarm" "and" "atan2" "bind" "binmode" "bless" "caller" "chdir" "chmod" "chown" "chr" "chroot" "close" @@ -5483,7 +5483,7 @@ indentation and initial hashes. Behaves usually outside of comment." "evalbytes" "exists" "finally" "for" "foreach" "format" "given" "goto" "grep" "if" "keys" "last" "local" "m" "map" "my" "next" "no" "our" "package" "pop" "pos" "print" "printf" "prototype" - "push" "q" "qq" "qw" "qx" "redo" "return" "s" "say" "scalar" + "push" "q" "qq" "qr" "qw" "qx" "redo" "return" "s" "say" "scalar" "shift" "sort" "splice" "split" "state" "study" "sub" "tie" "tied" "tr" "try" "undef" "unless" "unshift" "untie" "until" "use" "when" "while" "y")) From b24ae269b28673fabf4458f0c3d4afbf5c93a164 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 12 Feb 2021 18:21:45 +0000 Subject: [PATCH 147/297] ; Fix typo in last change to m4-mode.el. --- lisp/progmodes/m4-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index 431d86bddd2..7dfaed44282 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -78,7 +78,7 @@ If m4 is not in your PATH, set this to an absolute file name." "stack_foreach_sep" "stack_foreach_sep_lifo" "substr" "syscmd" "sysval" "traceoff" "traceon" "translit" "undefine" "undivert" "unix" "upcase" "windows") - "List of valid m4 macros. for M4 mode")) + "List of valid m4 macros for M4 mode.")) (defvar m4-font-lock-keywords (eval-when-compile From c4459a10a6962d90adc4cdfada36175aaed99dfc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 11 Feb 2021 20:41:02 +0100 Subject: [PATCH 148/297] Don't inline tramp-debug-message * lisp/net/tramp.el (tramp-debug-message): Change defsubst into defun. Until now the byte-compiler hasn't been clever enough to inline this function but this is about to change; the code expansion is unnecessary and makes compiler improvements more difficult to gauge. --- lisp/net/tramp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 690dd99ae55..e33075ec6f5 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1750,7 +1750,7 @@ The outline level is equal to the verbosity of the Tramp message." (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec)) (tramp-compat-temporary-file-directory))) -(defsubst tramp-debug-message (vec fmt-string &rest arguments) +(defun tramp-debug-message (vec fmt-string &rest arguments) "Append message to debug buffer of VEC. Message is formatted with FMT-STRING as control string and the remaining ARGUMENTS to actually emit the message (if applicable)." From ea29908c1870417eba98f27525a6f2f571d65396 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 11 Feb 2021 17:34:17 +0100 Subject: [PATCH 149/297] Avoid traversing dead `if` branches in bytecode optimiser There is no point in traversing conditional branches that are statically known never to be executed. This saves some optimisation effort, but more importantly prevents variable assignments and references in those branches from blocking effective constant propagation. Also attempt to traverse as much as possible in an unconditional context, which enables constant-propagation through (linear) assignments. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form): Rewrite the (tail) recursion into an explicit loop. Normalise a return value of (quote nil) to nil, for easier subsequent optimisations. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't traverse dead `if` branches. Use unconditional traversion context when possible. --- lisp/emacs-lisp/byte-opt.el | 64 ++++++++++++++++++------------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 8851f0ef32d..fec3407782e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -458,16 +458,22 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (cons fn (byte-optimize-body exps for-effect))) (`(if ,test ,then . ,else) + ;; FIXME: We are conservative here: any variable changed in the + ;; THEN branch will be barred from substitution in the ELSE + ;; branch, despite the branches being mutually exclusive. + ;; The test is always executed. (let* ((test-opt (byte-optimize-form test nil)) - ;; The THEN and ELSE branches are executed conditionally. - ;; - ;; FIXME: We are conservative here: any variable changed in the - ;; THEN branch will be barred from substitution in the ELSE - ;; branch, despite the branches being mutually exclusive. - (byte-optimize--vars-outside-condition byte-optimize--lexvars) - (then-opt (byte-optimize-form then for-effect)) - (else-opt (byte-optimize-body else for-effect))) + (const (macroexp-const-p test-opt)) + ;; The branches are traversed unconditionally when possible. + (byte-optimize--vars-outside-condition + (if const + byte-optimize--vars-outside-condition + byte-optimize--lexvars)) + ;; Avoid traversing dead branches. + (then-opt (and test-opt (byte-optimize-form then for-effect))) + (else-opt (and (not (and test-opt const)) + (byte-optimize-body else for-effect)))) `(if ,test-opt ,then-opt . ,else-opt))) (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. @@ -638,30 +644,24 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (defun byte-optimize-form (form &optional for-effect) "The source-level pass of the optimizer." - ;; - ;; First, optimize all sub-forms of this one. - (setq form (byte-optimize-form-code-walker form for-effect)) - ;; - ;; after optimizing all subforms, optimize this form until it doesn't - ;; optimize any further. This means that some forms will be passed through - ;; the optimizer many times, but that's necessary to make the for-effect - ;; processing do as much as possible. - ;; - (let (opt new) - (if (and (consp form) - (symbolp (car form)) - (or ;; (and for-effect - ;; ;; We don't have any of these yet, but we might. - ;; (setq opt (get (car form) - ;; 'byte-for-effect-optimizer))) - (setq opt (function-get (car form) 'byte-optimizer))) - (not (eq form (setq new (funcall opt form))))) - (progn -;; (if (equal form new) (error "bogus optimizer -- %s" opt)) - (byte-compile-log " %s\t==>\t%s" form new) - (setq new (byte-optimize-form new for-effect)) - new) - form))) + (while + (progn + ;; First, optimize all sub-forms of this one. + (setq form (byte-optimize-form-code-walker form for-effect)) + + ;; If a form-specific optimiser is available, run it and start over + ;; until a fixpoint has been reached. + (and (consp form) + (symbolp (car form)) + (let ((opt (function-get (car form) 'byte-optimizer))) + (and opt + (let ((old form) + (new (funcall opt form))) + (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)) (defun byte-optimize-let-form (head form for-effect) ;; Recursively enter the optimizer for the bindings and body From 5a11e9185c0416df8fa3a15bb0d60b6ba6827869 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 12 Feb 2021 19:41:07 +0100 Subject: [PATCH 150/297] byte-opt.el: More concise expression * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Refactor `setq` clause. --- lisp/emacs-lisp/byte-opt.el | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index fec3407782e..c383e0285b9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -593,16 +593,15 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (lexvar (assq var byte-optimize--lexvars)) (value (byte-optimize-form expr nil))) (when lexvar - ;; If it's bound outside conditional, invalidate. - (if (assq var byte-optimize--vars-outside-condition) - ;; We are in conditional code and the variable was - ;; bound outside: cancel substitutions. - (setcdr (cdr lexvar) nil) - ;; Set a new value (if substitutable). - (setcdr (cdr lexvar) - (and (byte-optimize--substitutable-p value) - (list value)))) - (setcar (cdr lexvar) t)) ; Mark variable to be kept. + ;; Set a new value or inhibit further substitution. + (setcdr (cdr lexvar) + (and + ;; Inhibit if bound outside conditional code. + (not (assq var byte-optimize--vars-outside-condition)) + ;; The new value must be substitutable. + (byte-optimize--substitutable-p value) + (list value))) + (setcar (cdr lexvar) t)) ; Mark variable to be kept. (push var var-expr-list) (push value var-expr-list)) (setq args (cddr args))) From 9518926220943d5c405e03d7352343341e07ba83 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 12 Feb 2021 19:43:41 +0100 Subject: [PATCH 151/297] Simplify expression in byte-code decompiler * lisp/emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Replace roundabout expression with what it essentially does. --- lisp/emacs-lisp/byte-opt.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c383e0285b9..e0feb95a461 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1562,10 +1562,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; so we create a copy of it, and replace the addresses with ;; TAGs. (let ((orig-table last-constant)) - (cl-loop for e across constvec - when (eq e last-constant) - do (setq last-constant (copy-hash-table e)) - and return nil) + (setq last-constant (copy-hash-table last-constant)) ;; Replace all addresses with TAGs. (maphash #'(lambda (value offset) (let ((match (assq offset tags))) From f8dbefbaa59bb17dd4a2dfa4d9ff560c46785792 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 16:08:01 -0500 Subject: [PATCH 152/297] Use `declare` instead of `def-edebug-spec` in most places * lisp/speedbar.el: Use lexical-binding. (speedbar-with-writable): Use `declare`. * lisp/subr.el (def-edebug-spec): Use `declare`. * lisp/cedet/ede/base.el: Use lexical-binding. (ede-with-projectfile): Use `declare`. (recentf-exclude): Declare var. * lisp/cedet/ede/pmake.el: Use lexical-binding. (ede-pmake-insert-variable-shared, ede-pmake-insert-variable-once): Use `declare`. * lisp/cedet/ede/proj-comp.el: Use lexical-binding. (ede-compiler-begin-unique, ede-compiler-only-once) (ede-linker-begin-unique, ede-linker-only-once): Use `declare`. * lisp/cedet/semantic/ctxt.el: Use lexical-binding. (semantic-with-buffer-narrowed-to-context) (semantic-with-buffer-narrowed-to-command): Use `declare`. (semantic--progress-reporter): Declare var. (semantic-ctxt-end-of-symbol-default): Remove unused var `fieldsep`. * lisp/cedet/semantic/lex-spp.el: Use lexical-binding. (define-lex-spp-macro-declaration-analyzer) (define-lex-spp-include-analyzer, semantic-lex-with-macro-used) (define-lex-spp-macro-undeclaration-analyzer): Use `declare`. (semantic-lex-spp-symbol-remove): Rename arg to avoid colliding with dynamic variable `obarray`. (semantic-lex-spp-symbol-pop): Remove unused var `oldvalue`. (semantic-lex-spp-lex-text-string): Remove unused var `analyzer`. * lisp/cedet/semantic/lex.el (define-lex) (semantic-lex-unterminated-syntax-protection, define-lex-analyzer) (define-lex-regex-analyzer, define-lex-block-analyzer) (semantic-lex-catch-errors): Use `declare`. * lisp/cedet/semantic/tag.el: Use lexical-binding. (semantic-with-buffer-narrowed-to-current-tag) (semantic-with-buffer-narrowed-to-tag): Use `declare`. * lisp/cedet/semantic/wisent.el: Use lexical-binding. (define-wisent-lexer): Use `declare`. * lisp/emacs-lisp/cl-lib.el (cl-pushnew): The arg to :test can be any form not just function form. * lisp/org/ob-comint.el (org-babel-comint-in-buffer) (org-babel-comint-with-output): Use `declare`. * lisp/org/ob-core.el (org-babel-map-src-blocks): Use `declare`. (org-babel-result-cond): Simplify edebug spec. * lisp/org/org-clock.el (org-with-clock-position, org-with-clock): * lisp/org/org-agenda.el (org-agenda-with-point-at-orig-entry): * lisp/org/ob-tangle.el (org-babel-with-temp-filebuffer): Use `declare`. * lisp/textmodes/rst.el (push): Remove redundant edebug spec. * lisp/vc/pcvs-parse.el: Use lexical-binding. (cvs-parse-buffer): Rename arg to avoid dynbound conflict. (cvs-or): Use `declare`. --- lisp/cedet/ede/base.el | 29 +++++++----------- lisp/cedet/ede/pmake.el | 22 +++++++------- lisp/cedet/ede/proj-comp.el | 35 +++++++--------------- lisp/cedet/semantic/ctxt.el | 24 ++++++--------- lisp/cedet/semantic/lex-spp.el | 55 ++++++++++------------------------ lisp/cedet/semantic/lex.el | 38 +++++------------------ lisp/cedet/semantic/tag.el | 14 ++------- lisp/cedet/semantic/wisent.el | 15 ++-------- lisp/emacs-lisp/cl-lib.el | 2 +- lisp/eshell/esh-var.el | 2 +- lisp/org/ob-comint.el | 6 ++-- lisp/org/ob-core.el | 17 +++++------ lisp/org/ob-tangle.el | 3 +- lisp/org/org-agenda.el | 2 +- lisp/org/org-clock.el | 6 ++-- lisp/org/org-pcomplete.el | 11 +++---- lisp/pcmpl-gnu.el | 8 ++--- lisp/pcmpl-linux.el | 6 ++-- lisp/pcmpl-unix.el | 2 +- lisp/pcmpl-x.el | 3 +- lisp/shell.el | 2 +- lisp/speedbar.el | 9 ++---- lisp/subr.el | 1 + lisp/textmodes/rst.el | 4 --- lisp/vc/pcvs-parse.el | 15 +++++----- 25 files changed, 111 insertions(+), 220 deletions(-) diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 810d6ef3bd4..3fcc023e0c6 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -1,4 +1,4 @@ -;;; ede/base.el --- Baseclasses for EDE. +;;; ede/base.el --- Baseclasses for EDE -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -288,7 +288,7 @@ All specific project types must derive from this project." ;; (defmacro ede-with-projectfile (obj &rest forms) "For the project in which OBJ resides, execute FORMS." - (declare (indent 1)) + (declare (indent 1) (debug t)) (unless (symbolp obj) (message "Beware! ede-with-projectfile's first arg is copied: %S" obj)) `(let* ((pf (if (obj-of-class-p ,obj 'ede-target) @@ -317,13 +317,15 @@ If set to nil, then the cache is not saved." (defvar ede-project-cache-files nil "List of project files EDE has seen before.") +(defvar recentf-exclude) + (defun ede-save-cache () "Save a cache of EDE objects that Emacs has seen before." (interactive) (when ede-project-placeholder-cache-file (let ((p ede-projects) (c ede-project-cache-files) - (recentf-exclude '( (lambda (f) t) )) + (recentf-exclude `( ,(lambda (_) t) )) ) (condition-case nil (progn @@ -461,7 +463,7 @@ Not all buffers need headers, so return nil if no applicable." (ede-buffer-header-file ede-object (current-buffer)) nil)) -(cl-defmethod ede-buffer-header-file ((this ede-project) buffer) +(cl-defmethod ede-buffer-header-file ((_this ede-project) _buffer) "Return nil, projects don't have header files." nil) @@ -487,12 +489,12 @@ Some projects may have multiple documentation files, so return a list." (ede-buffer-documentation-files ede-object (current-buffer)) nil)) -(cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer) +(cl-defmethod ede-buffer-documentation-files ((this ede-project) _buffer) "Return all documentation in project THIS based on BUFFER." ;; Find the info node. (ede-documentation this)) -(cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer) +(cl-defmethod ede-buffer-documentation-files ((_this ede-target) buffer) "Check for some documentation files for THIS. Also do a quick check to see if there is a Documentation tag in this BUFFER." (with-current-buffer buffer @@ -518,7 +520,7 @@ files in the project." proj (cdr proj))) found)) -(cl-defmethod ede-documentation ((this ede-target)) +(cl-defmethod ede-documentation ((_this ede-target)) "Return a list of files that provide documentation. Documentation is not for object THIS, but is provided by THIS for other files in the project." @@ -529,7 +531,7 @@ files in the project." (ede-html-documentation (ede-toplevel)) ) -(cl-defmethod ede-html-documentation ((this ede-project)) +(cl-defmethod ede-html-documentation ((_this ede-project)) "Return a list of HTML files provided by project THIS." ) @@ -636,18 +638,7 @@ PROJECT-FILE-NAME is a name of project file (short name, like `pom.xml', etc." (oset this directory (file-name-directory (oref this file)))) ) - - -;;; Hooks & Autoloads -;; -;; These let us watch various activities, and respond appropriately. - -;; (add-hook 'edebug-setup-hook -;; (lambda () -;; (def-edebug-spec ede-with-projectfile -;; (form def-body)))) - (provide 'ede/base) ;; Local variables: diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el index 4c948df4102..e1fe85659f8 100644 --- a/lisp/cedet/ede/pmake.el +++ b/lisp/cedet/ede/pmake.el @@ -1,4 +1,4 @@ -;;; ede-pmake.el --- EDE Generic Project Makefile code generator. +;;; ede-pmake.el --- EDE Generic Project Makefile code generator -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc. @@ -241,6 +241,7 @@ MFILENAME is the makefile to generate." (defmacro ede-pmake-insert-variable-shared (varname &rest body) "Add VARNAME into the current Makefile. Execute BODY in a location where a value can be placed." + (declare (debug t) (indent 1)) `(let ((addcr t) (v ,varname)) (if (save-excursion (goto-char (point-max)) @@ -258,11 +259,11 @@ Execute BODY in a location where a value can be placed." ,@body (if addcr (insert "\n")) (goto-char (point-max)))) -(put 'ede-pmake-insert-variable-shared 'lisp-indent-function 1) (defmacro ede-pmake-insert-variable-once (varname &rest body) "Add VARNAME into the current Makefile if it doesn't exist. Execute BODY in a location where a value can be placed." + (declare (debug t) (indent 1)) `(let ((addcr t) (v ,varname)) (unless (save-excursion @@ -271,7 +272,6 @@ Execute BODY in a location where a value can be placed." ,@body (when addcr (insert "\n")) (goto-char (point-max))))) -(put 'ede-pmake-insert-variable-once 'lisp-indent-function 1) ;;; SOURCE VARIABLE NAME CONSTRUCTION @@ -289,7 +289,7 @@ Change . to _ in the variable name." ;;; DEPENDENCY FILE GENERATOR LISTS ;; -(cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target)) +(cl-defmethod ede-proj-makefile-dependency-files ((_this ede-proj-target)) "Return a list of source files to convert to dependencies. Argument THIS is the target to get sources from." nil) @@ -302,7 +302,7 @@ Argument THIS is the target to get sources from." Use CONFIGURATION as the current configuration to query." (cdr (assoc configuration (oref this configuration-variables)))) -(cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project)) +(cl-defmethod ede-proj-makefile-insert-variables-new ((_this ede-proj-project)) "Insert variables needed by target THIS. NOTE: Not yet in use! This is part of an SRecode conversion of @@ -420,7 +420,7 @@ Use CONFIGURATION as the current configuration to query." (cdr (assoc configuration (oref this configuration-variables)))) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile) - &optional moresource) + &optional _moresource) "Insert variables needed by target THIS. Optional argument MORESOURCE is a list of additional sources to add to the sources variable." @@ -449,12 +449,12 @@ sources variable." (ede-proj-makefile-insert-variables linker))))) (cl-defmethod ede-proj-makefile-insert-automake-pre-variables - ((this ede-proj-target)) + ((_this ede-proj-target)) "Insert variables needed by target THIS in Makefile.am before SOURCES." nil) (cl-defmethod ede-proj-makefile-insert-automake-post-variables - ((this ede-proj-target)) + ((_this ede-proj-target)) "Insert variables needed by target THIS in Makefile.am after SOURCES." nil) @@ -511,7 +511,7 @@ Argument THIS is the project that should insert stuff." (mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets)) ) -(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target)) +(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((_this ede-proj-target)) "Insert any symbols that the DIST rule should depend on. Argument THIS is the target that should insert stuff." nil) @@ -530,7 +530,7 @@ Argument THIS is the target that should insert stuff." (insert " " (ede-subproject-relative-path sproj)) )))) -(cl-defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project)) +(cl-defmethod ede-proj-makefile-automake-insert-extradist ((_this ede-proj-project)) "Insert the EXTRADIST variable entries needed for Automake and EDE." (proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede"))) @@ -602,7 +602,7 @@ Argument THIS is the target that should insert stuff." "\t@false\n\n" "\n\n# End of Makefile\n"))) -(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target)) +(cl-defmethod ede-proj-makefile-insert-rules ((_this ede-proj-target)) "Insert rules needed by THIS target." nil) diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el index 26aa66873a3..ba52784a7a8 100644 --- a/lisp/cedet/ede/proj-comp.el +++ b/lisp/cedet/ede/proj-comp.el @@ -1,4 +1,4 @@ -;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver +;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2021 Free Software ;; Foundation, Inc. @@ -172,12 +172,12 @@ Adds this rule to a .PHONY list.")) This is used when creating a Makefile to prevent duplicate variables and rules from being created.") -(cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields) +(cl-defmethod initialize-instance :after ((this ede-compiler) &rest _fields) "Make sure that all ede compiler objects are cached in `ede-compiler-list'." (add-to-list 'ede-compiler-list this)) -(cl-defmethod initialize-instance :after ((this ede-linker) &rest fields) +(cl-defmethod initialize-instance :after ((this ede-linker) &rest _fields) "Make sure that all ede compiler objects are cached in `ede-linker-list'." (add-to-list 'ede-linker-list this)) @@ -185,11 +185,13 @@ rules from being created.") (defmacro ede-compiler-begin-unique (&rest body) "Execute BODY, making sure that `ede-current-build-list' is maintained. This will prevent rules from creating duplicate variables or rules." + (declare (indent 0) (debug t)) `(let ((ede-current-build-list nil)) ,@body)) (defmacro ede-compiler-only-once (object &rest body) "Using OBJECT, execute BODY only once per Makefile generation." + (declare (indent 1) (debug t)) `(if (not (member ,object ede-current-build-list)) (progn (add-to-list 'ede-current-build-list ,object) @@ -198,25 +200,18 @@ This will prevent rules from creating duplicate variables or rules." (defmacro ede-linker-begin-unique (&rest body) "Execute BODY, making sure that `ede-current-build-list' is maintained. This will prevent rules from creating duplicate variables or rules." + (declare (indent 0) (debug t)) `(let ((ede-current-build-list nil)) ,@body)) (defmacro ede-linker-only-once (object &rest body) "Using OBJECT, execute BODY only once per Makefile generation." + (declare (indent 1) (debug t)) `(if (not (member ,object ede-current-build-list)) (progn (add-to-list 'ede-current-build-list ,object) ,@body))) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec ede-compiler-begin-unique def-body) - (def-edebug-spec ede-compiler-only-once (form def-body)) - (def-edebug-spec ede-linker-begin-unique def-body) - (def-edebug-spec ede-linker-only-once (form def-body)) - (def-edebug-spec ede-pmake-insert-variable-shared (form def-body)) - )) - ;;; Queries (defun ede-proj-find-compiler (compilers sourcetype) "Return a compiler from the list COMPILERS that will compile SOURCETYPE." @@ -246,7 +241,7 @@ This will prevent rules from creating duplicate variables or rules." ) (oref this autoconf))) -(cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program)) +(cl-defmethod ede-proj-flush-autoconf ((_this ede-compilation-program)) "Flush the configure file (current buffer) to accommodate THIS." nil) @@ -281,8 +276,8 @@ If this compiler creates code that can be linked together, then the object files created by the compiler are considered intermediate." (oref this uselinker)) -(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler) - targetname) +(cl-defmethod ede-compiler-intermediate-object-variable ((_this ede-compiler) + targetname) "Return a string based on THIS representing a make object variable. TARGETNAME is the name of the target that these objects belong to." (concat targetname "_OBJ")) @@ -343,16 +338,6 @@ compiler it decides to use after inserting in the rule." commands)) (insert "\n"))) -;;; Some details about our new macro -;; -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec ede-compiler-begin-unique def-body))) -(put 'ede-compiler-begin-unique 'lisp-indent-function 0) -(put 'ede-compiler-only-once 'lisp-indent-function 1) -(put 'ede-linker-begin-unique 'lisp-indent-function 0) -(put 'ede-linker-only-once 'lisp-indent-function 1) - (provide 'ede/proj-comp) ;;; ede/proj-comp.el ends here diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el index 8d5b5dcdbdf..17ffaeff5e4 100644 --- a/lisp/cedet/semantic/ctxt.el +++ b/lisp/cedet/semantic/ctxt.el @@ -1,4 +1,4 @@ -;;; semantic/ctxt.el --- Context calculations for Semantic tools. +;;; semantic/ctxt.el --- Context calculations for Semantic tools -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -137,18 +137,16 @@ Return non-nil if there is no upper context." (defmacro semantic-with-buffer-narrowed-to-context (&rest body) "Execute BODY with the buffer narrowed to the current context." + (declare (indent 0) (debug t)) `(save-restriction (semantic-narrow-to-context) ,@body)) -(put 'semantic-with-buffer-narrowed-to-context 'lisp-indent-function 0) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec semantic-with-buffer-narrowed-to-context - (def-body)))) ;;; Local Variables ;; -;; + +(defvar semantic--progress-reporter) + (define-overloadable-function semantic-get-local-variables (&optional point) "Get the local variables based on POINT's context. Local variables are returned in Semantic tag format. @@ -345,14 +343,10 @@ beginning and end of a command." (defmacro semantic-with-buffer-narrowed-to-command (&rest body) "Execute BODY with the buffer narrowed to the current command." + (declare (indent 0) (debug t)) `(save-restriction (semantic-narrow-to-command) ,@body)) -(put 'semantic-with-buffer-narrowed-to-command 'lisp-indent-function 0) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec semantic-with-buffer-narrowed-to-command - (def-body)))) (define-overloadable-function semantic-ctxt-end-of-symbol (&optional point) "Move point to the end of the current symbol under POINT. @@ -374,7 +368,7 @@ work on C like languages." ;; NOTE: The [ \n] expression below should used \\s-, but that ;; doesn't work in C since \n means end-of-comment, and isn't ;; really whitespace. - (fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)")) + ;;(fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)")) (case-fold-search semantic-case-fold) (continuesearch t) (end nil) @@ -655,7 +649,7 @@ POINT defaults to the value of point in current buffer. You should override this function in multiple mode buffers to determine which major mode apply at point.") -(defun semantic-ctxt-current-mode-default (&optional point) +(defun semantic-ctxt-current-mode-default (&optional _point) "Return the major mode active at POINT. POINT defaults to the value of point in current buffer. This default implementation returns the current major mode." @@ -671,7 +665,7 @@ The return value can be a mixed list of either strings (names of types that are in scope) or actual tags (type declared locally that may or may not have a name.)") -(defun semantic-ctxt-scoped-types-default (&optional point) +(defun semantic-ctxt-scoped-types-default (&optional _point) "Return a list of scoped types by name for the current context at POINT. This is very different for various languages, and does nothing unless overridden." diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 408011c6286..5675b9f3e37 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -1,4 +1,4 @@ -;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor +;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -106,22 +106,12 @@ added and removed from this symbol table.") Pushes NAME into the macro stack. The above stack is checked by `semantic-lex-spp-symbol' to not return true for any symbol currently being expanded." + (declare (indent 1) (debug (symbolp def-body))) `(unwind-protect (progn (push ,name semantic-lex-spp-expanded-macro-stack) ,@body) (pop semantic-lex-spp-expanded-macro-stack))) -(put 'semantic-lex-with-macro-used 'lisp-indent-function 1) - -(add-hook - 'edebug-setup-hook - #'(lambda () - - (def-edebug-spec semantic-lex-with-macro-used - (symbolp def-body) - ) - - )) ;;; MACRO TABLE UTILS ;; @@ -190,7 +180,7 @@ Disable debugging by entering nothing." (setq semantic-lex-spp-debug-symbol nil) (setq semantic-lex-spp-debug-symbol sym))) -(defmacro semantic-lex-spp-validate-value (name value) +(defmacro semantic-lex-spp-validate-value (_name _value) "Validate the NAME and VALUE of a macro before it is set." ; `(progn ; (when (not (semantic-lex-spp-value-valid-p ,value)) @@ -212,12 +202,11 @@ the dynamic map." (semantic-lex-spp-dynamic-map))) value)) -(defsubst semantic-lex-spp-symbol-remove (name &optional obarray) +(defsubst semantic-lex-spp-symbol-remove (name &optional map) "Remove the spp symbol with NAME. -If optional OBARRAY is non-nil, then use that obarray instead of +If optional obarray MAP is non-nil, then use that obarray instead of the dynamic map." - (unintern name (or obarray - (semantic-lex-spp-dynamic-map)))) + (unintern name (or map (semantic-lex-spp-dynamic-map)))) (defun semantic-lex-spp-symbol-push (name value) "Push macro NAME with VALUE into the map. @@ -246,7 +235,7 @@ Reverse with `semantic-lex-spp-symbol-pop'." (stack (semantic-lex-spp-dynamic-map-stack)) (mapsym (intern name map)) (stacksym (intern name stack)) - (oldvalue nil) + ;; (oldvalue nil) ) (if (or (not (boundp stacksym) ) (= (length (symbol-value stacksym)) 0)) @@ -324,7 +313,7 @@ For use with semanticdb restoration of state." ;; Default obarray for below is the dynamic map. (semantic-lex-spp-symbol-set (car e) (cdr e)))) -(defun semantic-lex-spp-reset-hook (start end) +(defun semantic-lex-spp-reset-hook (start _end) "Reset anything needed by SPP for parsing. In this case, reset the dynamic macro symbol table if START is (point-min). @@ -354,7 +343,7 @@ Return non-nil if it matches" (string-match regex value)) )) -(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end argvalues) +(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end _argvalues) "Convert lexical macro contents VAL into a macro expansion stream. These are for simple macro expansions that a user may have typed in directly. As such, we need to analyze the input text, to figure out what kind of real @@ -819,7 +808,7 @@ ARGVALUES are values for any arg list, or nil." ;; An analyzer that will push tokens from a macro in place ;; of the macro symbol. ;; -(defun semantic-lex-spp-analyzer-do-replace (sym val beg end) +(defun semantic-lex-spp-analyzer-do-replace (_sym val beg end) "Do the lexical replacement for SYM with VAL. Argument BEG and END specify the bounds of SYM in the buffer." (if (not val) @@ -1045,7 +1034,7 @@ and variable state from the current buffer." (fresh-toks nil) (toks nil) (origbuff (current-buffer)) - (analyzer semantic-lex-analyzer) + ;; (analyzer semantic-lex-analyzer) (important-vars '(semantic-lex-spp-macro-symbol-obarray semantic-lex-spp-project-macro-symbol-obarray semantic-lex-spp-dynamic-macro-symbol-obarray @@ -1176,6 +1165,7 @@ of type `spp-macro-def' is to be created. VALFORM are forms that return the value to be saved for this macro, or nil. When implementing a macro, you can use `semantic-lex-spp-stream-for-macro' to convert text into a lexical stream for storage in the macro." + (declare (debug (&define name stringp stringp form def-body))) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) @@ -1209,6 +1199,7 @@ REGEXP is a regular expression for the analyzer to match. See `define-lex-regex-analyzer' for more on regexp. TOKIDX is an index into REGEXP for which a new lexical token of type `spp-macro-undef' is to be created." + (declare (debug (&define name stringp stringp form))) (let ((start (make-symbol "start")) (end (make-symbol "end"))) `(define-lex-regex-analyzer ,name @@ -1244,7 +1235,7 @@ Note: Not implemented yet." :group 'semantic :type 'boolean) -(defun semantic-lex-spp-merge-header (name) +(defun semantic-lex-spp-merge-header (_name) "Extract and merge any macros from the header with NAME. Finds the header file belonging to NAME, gets the macros from that file, and then merge the macros with our current @@ -1269,6 +1260,7 @@ type of include. The return value should be of the form: (NAME . TYPE) where NAME is the name of the include, and TYPE is the type of the include, where a valid symbol is `system', or nil." + (declare (debug (&define name stringp stringp form def-body))) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) @@ -1369,23 +1361,6 @@ If BUFFER is not provided, use the current buffer." (princ "\n") )))) -;;; EDEBUG Handlers -;; -(add-hook - 'edebug-setup-hook - #'(lambda () - - (def-edebug-spec define-lex-spp-macro-declaration-analyzer - (&define name stringp stringp form def-body) - ) - - (def-edebug-spec define-lex-spp-macro-undeclaration-analyzer - (&define name stringp stringp form) - ) - - (def-edebug-spec define-lex-spp-include-analyzer - (&define name stringp stringp form def-body)))) - (provide 'semantic/lex-spp) ;; Local variables: diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index ae70d5c730a..b3399aa2e62 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -760,6 +760,7 @@ If two analyzers can match the same text, it is important to order the analyzers so that the one you want to match first occurs first. For example, it is good to put a number analyzer in front of a symbol analyzer which might mistake a number for a symbol." + (declare (debug (&define name stringp (&rest symbolp)))) `(defun ,name (start end &optional depth length) ,(concat doc "\nSee `semantic-lex' for more information.") ;; Make sure the state of block parsing starts over. @@ -1064,14 +1065,13 @@ the desired syntax, and a position returned. If `debug-on-error' is set, errors are not caught, so that you can debug them. Avoid using a large FORMS since it is duplicated." + (declare (indent 1) (debug t)) `(if (and debug-on-error semantic-lex-debug-analyzers) (progn ,@forms) (condition-case nil (progn ,@forms) (error (semantic-lex-unterminated-syntax-detected ,syntax))))) -(put 'semantic-lex-unterminated-syntax-protection - 'lisp-indent-function 1) (defmacro define-lex-analyzer (name doc condition &rest forms) "Create a single lexical analyzer NAME with DOC. @@ -1096,6 +1096,7 @@ Proper action in FORMS is to move the value of `semantic-lex-end-point' to after the location of the analyzed entry, and to add any discovered tokens at the beginning of `semantic-lex-token-stream'. This can be done by using `semantic-lex-push-token'." + (declare (debug (&define name stringp form def-body))) `(eval-and-compile (defvar ,name nil ,doc) (defun ,name nil) @@ -1122,6 +1123,7 @@ This can be done by using `semantic-lex-push-token'." "Create a lexical analyzer with NAME and DOC that will match REGEXP. FORMS are evaluated upon a successful match. See `define-lex-analyzer' for more about analyzers." + (declare (debug (&define name stringp form def-body))) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1139,6 +1141,8 @@ expression. FORMS are evaluated upon a successful match BEFORE the new token is created. It is valid to ignore FORMS. See `define-lex-analyzer' for more about analyzers." + (declare (debug + (&define name stringp form symbolp [ &optional form ] def-body))) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1163,6 +1167,7 @@ where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM and CLOSE-DELIM are respectively the open and close delimiters identifying a block. OPEN-SYM and CLOSE-SYM are respectively the symbols returned in open and close tokens." + (declare (debug (&define name stringp form (&rest form)))) (let ((specs (cons spec1 specs)) spec open olist clist) (while specs @@ -1684,6 +1689,7 @@ the error will be caught here without the buffer's cache being thrown out of date. If there is an error, the syntax that failed is returned. If there is no error, then the last value of FORMS is returned." + (declare (indent 1) (debug (symbolp def-body))) (let ((ret (make-symbol "ret")) (syntax (make-symbol "syntax")) (start (make-symbol "start")) @@ -1707,35 +1713,7 @@ If there is no error, then the last value of FORMS is returned." ;;(message "Buffer not currently parsable (%S)." ,ret) (semantic-parse-tree-unparseable)) ,ret))) -(put 'semantic-lex-catch-errors 'lisp-indent-function 1) - -;;; Interfacing with edebug -;; -(add-hook - 'edebug-setup-hook - #'(lambda () - - (def-edebug-spec define-lex - (&define name stringp (&rest symbolp)) - ) - (def-edebug-spec define-lex-analyzer - (&define name stringp form def-body) - ) - (def-edebug-spec define-lex-regex-analyzer - (&define name stringp form def-body) - ) - (def-edebug-spec define-lex-simple-regex-analyzer - (&define name stringp form symbolp [ &optional form ] def-body) - ) - (def-edebug-spec define-lex-block-analyzer - (&define name stringp form (&rest form)) - ) - (def-edebug-spec semantic-lex-catch-errors - (symbolp def-body) - ) - - )) ;;; Compatibility with Semantic 1.x lexical analysis diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index 85defe4f2c0..3d7bce8657a 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -1,4 +1,4 @@ -;;; semantic/tag.el --- tag creation and access +;;; semantic/tag.el --- Tag creation and access -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc. @@ -1038,25 +1038,17 @@ See `semantic-tag-bounds'." (defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body) "Execute BODY with the buffer narrowed to the current tag." + (declare (indent 0) (debug t)) `(save-restriction (semantic-narrow-to-tag (semantic-current-tag)) ,@body)) -(put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag - (def-body)))) (defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body) "Narrow to TAG, and execute BODY." + (declare (indent 1) (debug t)) `(save-restriction (semantic-narrow-to-tag ,tag) ,@body)) -(put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec semantic-with-buffer-narrowed-to-tag - (def-body)))) ;;; Tag Hooks ;; diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index d5b73244a08..ecd96831352 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -1,4 +1,4 @@ -;;; semantic/wisent.el --- Wisent - Semantic gateway +;;; semantic/wisent.el --- Wisent - Semantic gateway -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2007, 2009-2021 Free Software Foundation, Inc. @@ -69,6 +69,7 @@ Returned tokens must have the form: (TOKSYM VALUE START . END) where VALUE is the buffer substring between START and END positions." + (declare (debug (&define name stringp def-body))) `(defun ,name () ,doc (cond @@ -319,18 +320,6 @@ the standard function `semantic-parse-region'." (point-max)))))) ;; Return parse tree (nreverse ptree))) - -;;; Interfacing with edebug -;; -(add-hook - 'edebug-setup-hook - #'(lambda () - - (def-edebug-spec define-wisent-lexer - (&define name stringp def-body) - ) - - )) (provide 'semantic/wisent) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 3bf3fd21ded..f06452ea174 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -140,7 +140,7 @@ to an element already in the list stored in PLACE. \n(fn X PLACE [KEYWORD VALUE]...)" (declare (debug (form place &rest - &or [[&or ":test" ":test-not" ":key"] function-form] + &or [[&or ":test" ":test-not" ":key"] form] [keywordp form]))) (if (symbolp place) (if (null keys) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index a09c47ce7c2..9fccc6b1c9d 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -355,7 +355,7 @@ This function is explicit for adding to `eshell-parse-argument-hook'." (defun pcomplete/eshell-mode/setq () "Completion function for Eshell's `setq'." (while (and (pcomplete-here (all-completions pcomplete-stub - obarray 'boundp)) + obarray #'boundp)) (pcomplete-here)))) ;; FIXME the real "env" command does more than this, it runs a program diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index 18d4f3c9388..b14849df691 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -44,7 +44,7 @@ BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is executed inside the protection of `save-excursion' and `save-match-data'." - (declare (indent 1)) + (declare (indent 1) (debug t)) `(progn (unless (org-babel-comint-buffer-livep ,buffer) (error "Buffer %s does not exist or has no process" ,buffer)) @@ -53,7 +53,6 @@ executed inside the protection of `save-excursion' and (save-excursion (let ((comint-input-filter (lambda (_input) nil))) ,@body)))))) -(def-edebug-spec org-babel-comint-in-buffer (form body)) (defmacro org-babel-comint-with-output (meta &rest body) "Evaluate BODY in BUFFER and return process output. @@ -67,7 +66,7 @@ elements are optional. This macro ensures that the filter is removed in case of an error or user `keyboard-quit' during execution of body." - (declare (indent 1)) + (declare (indent 1) (debug (sexp body))) (let ((buffer (nth 0 meta)) (eoe-indicator (nth 1 meta)) (remove-echo (nth 2 meta)) @@ -112,7 +111,6 @@ or user `keyboard-quit' during execution of body." string-buffer)) (setq string-buffer (substring string-buffer (match-end 0)))) (split-string string-buffer comint-prompt-regexp))))) -(def-edebug-spec org-babel-comint-with-output (sexp body)) (defun org-babel-comint-input-command (buffer cmd) "Pass CMD to BUFFER. diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 1343410792a..b1fd6943716 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -1100,7 +1100,7 @@ end-header-args -- point at the end of the header-args body ------------- string holding the body of the code block beg-body --------- point at the beginning of the body end-body --------- point at the end of the body" - (declare (indent 1)) + (declare (indent 1) (debug t)) (let ((tempvar (make-symbol "file"))) `(let* ((case-fold-search t) (,tempvar ,file) @@ -1139,7 +1139,6 @@ end-body --------- point at the end of the body" (goto-char end-block))))) (unless visited-p (kill-buffer to-be-removed)) (goto-char point)))) -(def-edebug-spec org-babel-map-src-blocks (form body)) ;;;###autoload (defmacro org-babel-map-inline-src-blocks (file &rest body) @@ -1354,7 +1353,7 @@ the `org-mode-hook'." (goto-char (match-beginning 0)) (org-babel-hide-hash) (goto-char (match-end 0)))))) -(add-hook 'org-mode-hook 'org-babel-hide-all-hashes) +(add-hook 'org-mode-hook #'org-babel-hide-all-hashes) (defun org-babel-hash-at-point (&optional point) "Return the value of the hash at POINT. @@ -1372,7 +1371,7 @@ This can be called with `\\[org-ctrl-c-ctrl-c]'." Add `org-babel-hide-result' as an invisibility spec for hiding portions of results lines." (add-to-invisibility-spec '(org-babel-hide-result . t))) -(add-hook 'org-mode-hook 'org-babel-result-hide-spec) +(add-hook 'org-mode-hook #'org-babel-result-hide-spec) (defvar org-babel-hide-result-overlays nil "Overlays hiding results.") @@ -1443,11 +1442,11 @@ portions of results lines." (push ov org-babel-hide-result-overlays))))) ;; org-tab-after-check-for-cycling-hook -(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) +(add-hook 'org-tab-first-hook #'org-babel-hide-result-toggle-maybe) ;; Remove overlays when changing major mode (add-hook 'org-mode-hook (lambda () (add-hook 'change-major-mode-hook - 'org-babel-show-result-all 'append 'local))) + #'org-babel-show-result-all 'append 'local))) (defun org-babel-params-from-properties (&optional lang no-eval) "Retrieve source block parameters specified as properties. @@ -3075,8 +3074,7 @@ Emacs shutdown.")) (defmacro org-babel-result-cond (result-params scalar-form &rest table-forms) "Call the code to parse raw string results according to RESULT-PARAMS." - (declare (indent 1) - (debug (form form &rest form))) + (declare (indent 1) (debug t)) (org-with-gensyms (params) `(let ((,params ,result-params)) (unless (member "none" ,params) @@ -3093,7 +3091,6 @@ Emacs shutdown.")) (not (member "table" ,params)))) ,scalar-form ,@table-forms))))) -(def-edebug-spec org-babel-result-cond (form form body)) (defun org-babel-temp-file (prefix &optional suffix) "Create a temporary file in the `org-babel-temporary-directory'. @@ -3136,7 +3133,7 @@ of `org-babel-temporary-directory'." org-babel-temporary-directory "[directory not defined]")))))) -(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) +(add-hook 'kill-emacs-hook #'org-babel-remove-temporary-directory) (defun org-babel-one-header-arg-safe-p (pair safe-list) "Determine if the PAIR is a safe babel header arg according to SAFE-LIST. diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 3c3943c8fa9..aa0373ab88e 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -150,7 +150,7 @@ represented in the file." "Open FILE into a temporary buffer execute BODY there like `progn', then kill the FILE buffer returning the result of evaluating BODY." - (declare (indent 1)) + (declare (indent 1) (debug t)) (let ((temp-path (make-symbol "temp-path")) (temp-result (make-symbol "temp-result")) (temp-file (make-symbol "temp-file")) @@ -164,7 +164,6 @@ evaluating BODY." (setf ,temp-result (progn ,@body))) (unless ,visited-p (kill-buffer ,temp-file)) ,temp-result))) -(def-edebug-spec org-babel-with-temp-filebuffer (form body)) ;;;###autoload (defun org-babel-tangle-file (file &optional target-file lang-re) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 99e5464c2b9..b9799d2abe8 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -2090,6 +2090,7 @@ Note that functions in this alist don't need to be quoted." If STRING is non-nil, the text property will be fetched from position 0 in that string. If STRING is nil, it will be fetched from the beginning of the current line." + (declare (debug t)) (org-with-gensyms (marker) `(let ((,marker (get-text-property (if ,string 0 (point-at-bol)) 'org-hd-marker ,string))) @@ -2097,7 +2098,6 @@ of the current line." (save-excursion (goto-char ,marker) ,@body))))) -(def-edebug-spec org-agenda-with-point-at-orig-entry (form body)) (defun org-add-agenda-custom-command (entry) "Replace or add a command in `org-agenda-custom-commands'. diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 2073b33380b..2844b0e511b 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -911,17 +911,17 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." (defmacro org-with-clock-position (clock &rest forms) "Evaluate FORMS with CLOCK as the current active clock." + (declare (indent 1) (debug t)) `(with-current-buffer (marker-buffer (car ,clock)) (org-with-wide-buffer (goto-char (car ,clock)) (beginning-of-line) ,@forms))) -(def-edebug-spec org-with-clock-position (form body)) -(put 'org-with-clock-position 'lisp-indent-function 1) (defmacro org-with-clock (clock &rest forms) "Evaluate FORMS with CLOCK as the current active clock. This macro also protects the current active clock from being altered." + (declare (indent 1) (debug t)) `(org-with-clock-position ,clock (let ((org-clock-start-time (cdr ,clock)) (org-clock-total-time) @@ -932,8 +932,6 @@ This macro also protects the current active clock from being altered." (org-back-to-heading t) (point-marker)))) ,@forms))) -(def-edebug-spec org-with-clock (form body)) -(put 'org-with-clock 'lisp-indent-function 1) (defsubst org-clock-clock-in (clock &optional resume start-time) "Clock in to the clock located by CLOCK. diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index 29d9d58482a..d8a4937b95a 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -239,11 +239,11 @@ When completing for #+STARTUP, for example, this function returns (require 'ox) (pcomplete-here (and org-export-exclude-tags - (list (mapconcat 'identity org-export-exclude-tags " "))))) + (list (mapconcat #'identity org-export-exclude-tags " "))))) (defun pcomplete/org-mode/file-option/filetags () "Complete arguments for the #+FILETAGS file option." - (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " ")))) + (pcomplete-here (and org-file-tags (mapconcat #'identity org-file-tags " ")))) (defun pcomplete/org-mode/file-option/language () "Complete arguments for the #+LANGUAGE file option." @@ -264,13 +264,13 @@ When completing for #+STARTUP, for example, this function returns (require 'ox) (pcomplete-here (and org-export-select-tags - (list (mapconcat 'identity org-export-select-tags " "))))) + (list (mapconcat #'identity org-export-select-tags " "))))) (defun pcomplete/org-mode/file-option/startup () "Complete arguments for the #+STARTUP file option." (while (pcomplete-here (let ((opts (pcomplete-uniquify-list - (mapcar 'car org-startup-options)))) + (mapcar #'car org-startup-options)))) ;; Some options are mutually exclusive, and shouldn't be completed ;; against if certain other options have already been seen. (dolist (arg pcomplete-args) @@ -340,7 +340,8 @@ When completing for #+STARTUP, for example, this function returns "Complete against TeX-style HTML entity names." (require 'org-entities) (while (pcomplete-here - (pcomplete-uniquify-list (remove nil (mapcar 'car-safe org-entities))) + (pcomplete-uniquify-list + (remove nil (mapcar #'car-safe org-entities))) (substring pcomplete-stub 1)))) (defun pcomplete/org-mode/todo () diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index dd964e36384..6c68645eb22 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -106,7 +106,7 @@ (while (pcomplete-here (completion-table-in-turn (pcmpl-gnu-make-rule-names) (pcomplete-entries)) - nil 'identity)))) + nil #'identity)))) (defun pcmpl-gnu-makefile-names () "Return a list of possible makefile names." @@ -336,7 +336,7 @@ Return the new list." (pcomplete-match-string 1 0))))) (unless saw-option (pcomplete-here - (mapcar 'char-to-string + (mapcar #'char-to-string (string-to-list "01234567ABCFGIKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz"))) (if (pcomplete-match "[xt]" 'first 1) @@ -355,7 +355,7 @@ Return the new list." (pcmpl-gnu-with-file-buffer file (mapcar #'tar-header-name tar-parse-info))))) (pcomplete-entries)) - nil 'identity)))) + nil #'identity)))) ;;;###autoload @@ -391,7 +391,7 @@ Return the new list." (string= prec "-execdir")) (while (pcomplete-here* (funcall pcomplete-command-completion-function) (pcomplete-arg 'last) t)))) - (while (pcomplete-here (pcomplete-dirs) nil 'identity)))) + (while (pcomplete-here (pcomplete-dirs) nil #'identity)))) ;;;###autoload (defalias 'pcomplete/gdb 'pcomplete/xargs) diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 2f42dbd4fa1..263d646dc6e 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -50,20 +50,20 @@ (while (pcomplete-here (if (file-directory-p "/proc") (directory-files "/proc" nil "\\`[0-9]+\\'")) - nil 'identity))) + nil #'identity))) ;;;###autoload (defun pcomplete/umount () "Completion for GNU/Linux `umount'." (pcomplete-opt "hVafrnvt(pcmpl-linux-fs-types)") (while (pcomplete-here (pcmpl-linux-mounted-directories) - nil 'identity))) + nil #'identity))) ;;;###autoload (defun pcomplete/mount () "Completion for GNU/Linux `mount'." (pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?") - (while (pcomplete-here (pcomplete-entries) nil 'identity))) + (while (pcomplete-here (pcomplete-entries) nil #'identity))) (defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/") diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index 70273b94a1b..c1aaf829dcf 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -77,7 +77,7 @@ being via `pcmpl-ssh-known-hosts-file'." (let ((pcomplete-help "(fileutils)rm invocation")) (pcomplete-opt "dfirRv") (while (pcomplete-here (pcomplete-all-entries) nil - 'expand-file-name)))) + #'expand-file-name)))) ;;;###autoload (defun pcomplete/xargs () diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el index 61d88666798..084f0e66bc8 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -301,7 +301,8 @@ long options." "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par" "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret" "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai" - "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur))) + "tes" "thr" "ucp" "use" "voi" "zdi") + (match-string 2 cur))) ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur) (pcomplete-here (pcomplete-dirs) (match-string 2 cur))) ((string-match "\\`-[Ee]\\(.*\\)\\'" cur) diff --git a/lisp/shell.el b/lisp/shell.el index 32128241655..9238ad1e8a0 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -463,7 +463,7 @@ Shell buffers. It implements `shell-completion-execonly' for (if (pcomplete-match "/") (pcomplete-here (pcomplete-entries nil (if shell-completion-execonly - 'file-executable-p))) + #'file-executable-p))) (pcomplete-here (nth 2 (shell--command-completion-data))))) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index e43978f4137..d64c72184ea 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1,4 +1,4 @@ -;;; speedbar --- quick access to files and tags in a frame +;;; speedbar --- quick access to files and tags in a frame -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -1640,7 +1640,7 @@ variable `speedbar-obj-alist'." (defmacro speedbar-with-writable (&rest forms) "Allow the buffer to be writable and evaluate FORMS." - (declare (indent 0)) + (declare (indent 0) (debug t)) `(let ((inhibit-read-only t)) ,@forms)) @@ -4001,11 +4001,6 @@ TEXT is the buffer's name, TOKEN and INDENT are unused." "Speedbar face for separator labels in a display." :group 'speedbar-faces) -;; some edebug hooks -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec speedbar-with-writable def-body))) - ;; Fix a font lock problem for some versions of Emacs (and (boundp 'font-lock-global-modes) font-lock-global-modes diff --git a/lisp/subr.el b/lisp/subr.el index eb287287608..454ea54b6a4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -88,6 +88,7 @@ Both SYMBOL and SPEC are unevaluated. The SPEC can be: a symbol (naming a function with an Edebug specification); or a list. The elements of the list describe the argument types; see Info node `(elisp)Specification List' for details." + (declare (indent 1)) `(put (quote ,symbol) 'edebug-form-spec (quote ,spec))) (defmacro lambda (&rest cdr) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 2b31e7ed612..c51285d3de6 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -105,10 +105,6 @@ ;; Common Lisp stuff (require 'cl-lib) -;; Correct wrong declaration. -(def-edebug-spec push - (&or [form symbolp] [form gv-place])) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el index 43816501bda..a95ea0d99da 100644 --- a/lisp/vc/pcvs-parse.el +++ b/lisp/vc/pcvs-parse.el @@ -1,4 +1,4 @@ -;;; pcvs-parse.el --- the CVS output parser +;;; pcvs-parse.el --- the CVS output parser -*- lexical-binding: t; -*- ;; Copyright (C) 1991-2021 Free Software Foundation, Inc. @@ -73,12 +73,12 @@ by `$'." '("status" "add" "commit" "update" "remove" "checkout" "ci") "List of CVS commands whose output is understood by the parser.") -(defun cvs-parse-buffer (parse-spec dont-change-disc &optional subdir) +(defun cvs-parse-buffer (parse-spec dcd &optional subdir) "Parse current buffer according to PARSE-SPEC. PARSE-SPEC is a function of no argument advancing the point and returning either a fileinfo or t (if the matched text should be ignored) or nil if it didn't match anything. -DONT-CHANGE-DISC just indicates whether the command was changing the disc +DCD just indicates whether the command was changing the disc or not (useful to tell the difference between `cvs-examine' and `cvs-update' output. The path names should be interpreted as relative to SUBDIR (defaults @@ -86,6 +86,7 @@ The path names should be interpreted as relative to SUBDIR (defaults Return a list of collected entries, or t if an error occurred." (goto-char (point-min)) (let ((fileinfos ()) + (dont-change-disc dcd) (cvs-current-dir "") (case-fold-search nil) (cvs-current-subdir (or subdir ""))) @@ -134,12 +135,12 @@ Match RE and if successful, execute MATCHES." (defmacro cvs-or (&rest alts) "Try each one of the ALTS alternatives until one matches." + (declare (debug t)) `(let ((-cvs-parse-point (point))) ,(cons 'or (mapcar (lambda (es) `(or ,es (ignore (goto-char -cvs-parse-point)))) alts)))) -(def-edebug-spec cvs-or t) ;; This is how parser tables should be executed (defun cvs-parse-run-table (parse-spec) @@ -190,9 +191,9 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." file (cvs-parse-msg) :subtype subtype keys)))) ;;;; CVS Process Parser Tables: -;;;; -;;;; The table for status and update could actually be merged since they -;;;; don't conflict. But they don't overlap much either. +;; +;; The table for status and update could actually be merged since they +;; don't conflict. But they don't overlap much either. (defun cvs-parse-table () "Table of message objects for `cvs-parse-process'." From c3163069a1e0a9aba16ae110ec75ace948e2ce0c Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 12 Feb 2021 21:26:08 +0000 Subject: [PATCH 153/297] Fix ElDoc setup for eval-expression * lisp/emacs-lisp/eldoc.el (eldoc--eval-expression-setup): Don't set global value of eldoc-documentation-strategy (bug#44886). --- lisp/emacs-lisp/eldoc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 90e075b1102..c95540ea3cf 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -248,7 +248,8 @@ expression point is on." :lighter eldoc-minor-mode-string #'elisp-eldoc-var-docstring nil t) (add-hook 'eldoc-documentation-functions #'elisp-eldoc-funcall nil t) - (setq eldoc-documentation-strategy 'eldoc-documentation-default))) + (setq-local eldoc-documentation-strategy + 'eldoc-documentation-default))) (eldoc-mode +1)) ;;;###autoload From bdd8d5b6a45bb66e230473fe221f8c1832bebb6c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 12 Feb 2021 19:07:12 +0100 Subject: [PATCH 154/297] Remove XEmacs and Emacs 21 compat code from cperl-mode * lisp/progmodes/cperl-mode.el (cperl-mode): Remove XEmacs and Emacs 21 compat code. (cperl-compilation-error-regexp-list): New variable. (cperl-compilation-error-regexp-alist): Make obsolete. --- lisp/progmodes/cperl-mode.el | 39 ++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 90ccdbf00ad..97d0e364644 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1396,13 +1396,15 @@ the last)." (defvar cperl-font-lock-multiline nil) (defvar cperl-font-locking nil) -;; NB as it stands the code in cperl-mode assumes this only has one -;; element. Since XEmacs 19 support has been dropped, this could all be simplified. -(defvar cperl-compilation-error-regexp-alist +(defvar cperl-compilation-error-regexp-list ;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS). - '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" - 2 3)) - "Alist that specifies how to match errors in perl output.") + '("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" + 2 3) + "List that specifies how to match errors in Perl output.") + +(defvar cperl-compilation-error-regexp-alist) +(make-obsolete-variable 'cperl-compilation-error-regexp-alist + 'cperl-compilation-error-regexp-list "28.1") (defvar compilation-error-regexp-alist) @@ -1639,19 +1641,18 @@ or as help on variables `cperl-tips', `cperl-problems', (setq-local imenu-sort-function nil) (setq-local vc-rcs-header cperl-vc-rcs-header) (setq-local vc-sccs-header cperl-vc-sccs-header) - (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x - (setq-local compilation-error-regexp-alist-alist - (cons (cons 'cperl (car cperl-compilation-error-regexp-alist)) - compilation-error-regexp-alist-alist)) - (if (fboundp 'compilation-build-compilation-error-regexp-alist) - (let ((f 'compilation-build-compilation-error-regexp-alist)) - (funcall f)) - (make-local-variable 'compilation-error-regexp-alist) - (push 'cperl compilation-error-regexp-alist))) - ((boundp 'compilation-error-regexp-alist);; xemacs 19.x - (setq-local compilation-error-regexp-alist - (append cperl-compilation-error-regexp-alist - compilation-error-regexp-alist)))) + (when (boundp 'compilation-error-regexp-alist-alist) + ;; The let here is just a compatibility kludge for the obsolete + ;; variable `cperl-compilation-error-regexp-alist'. It can be removed + ;; when that variable is removed. + (let ((regexp (if (boundp 'cperl-compilation-error-regexp-alist) + (car cperl-compilation-error-regexp-alist) + cperl-compilation-error-regexp-list))) + (setq-local compilation-error-regexp-alist-alist + (cons (cons 'cperl regexp) + compilation-error-regexp-alist-alist))) + (make-local-variable 'compilation-error-regexp-alist) + (push 'cperl compilation-error-regexp-alist)) (setq-local font-lock-defaults '((cperl-load-font-lock-keywords cperl-load-font-lock-keywords-1 From d1be48fdedabb451d5c6cf315fd5f09a632e771f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 19:28:25 -0500 Subject: [PATCH 155/297] Edebug: Overload `edebug-form-spec` even less The `edebug-form-spec` symbol property was used both to map forms's head symbol to the corresponding spec, and to map spec element names to their expansion. This lead to name conflicts which break instrumentation of examples such as (cl-flet ((gate (x) x)) (gate 4)) because of the Edebug spec element `gate`. So introduce a new symbol property `edebug-elem-spec`. * lisp/subr.el (def-edebug-elem-spec): New function. * lisp/emacs-lisp/edebug.el (edebug--get-elem-spec): New function. (edebug-match-symbol): Use it. (Core Edebug elems): Put them on `edebug-elem-spec` instead of `edebug-form-spec`. (ELisp special forms): Set their `edebug-form-spec` via dolist. (Other non-core Edebug elems): Use `def-edebug-elem-spec`. (edebug-\`): Use `declare`. * lisp/emacs-lisp/pcase.el (pcase-PAT, pcase-FUN, pcase-QPAT): * lisp/skeleton.el (skeleton-edebug-spec): * lisp/emacs-lisp/cl-macs.el: Use `def-edebug-elem-spec`. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests--conflicting-internal-names): New test. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-cl-flet1): New test case. * doc/lispref/edebug.texi (Specification List): Add `def-edebug-elem-spec`. (Specification Examples): Use it. * doc/lispref/loading.texi (Hooks for Loading): Avoid the use of `def-edebug-spec` in example (better use `debug` declaration). --- doc/lispref/edebug.texi | 41 ++-- doc/lispref/loading.texi | 2 +- etc/NEWS | 7 + lisp/emacs-lisp/cl-macs.el | 166 +++++++------- lisp/emacs-lisp/edebug.el | 216 +++++++++--------- lisp/emacs-lisp/pcase.el | 27 ++- lisp/skeleton.el | 8 +- lisp/subr.el | 17 +- .../edebug-resources/edebug-test-code.el | 10 + test/lisp/emacs-lisp/edebug-tests.el | 5 + 10 files changed, 267 insertions(+), 232 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 693d0e0630a..99d55c7ab95 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1203,7 +1203,7 @@ define Edebug specifications for special forms implemented in C. @defmac def-edebug-spec macro specification Specify which expressions of a call to macro @var{macro} are forms to be -evaluated. @var{specification} should be the edebug specification. +evaluated. @var{specification} should be the Edebug specification. Neither argument is evaluated. The @var{macro} argument can actually be any symbol, not just a macro @@ -1389,8 +1389,13 @@ indirect specification. If the symbol has an Edebug specification, this @dfn{indirect specification} should be either a list specification that is used in place of the symbol, or a function that is called to process the -arguments. The specification may be defined with @code{def-edebug-spec} -just as for macros. See the @code{defun} example. +arguments. The specification may be defined with +@code{def-edebug-elem-spec}: + +@defun def-edebug-elem-spec element specification +Define the @var{specification} to use in place of the symbol @var{element}. +@var{specification} has to be a list. +@end defun Otherwise, the symbol should be a predicate. The predicate is called with the argument, and if the predicate returns @code{nil}, the @@ -1568,14 +1573,14 @@ specification for @code{defmacro} is very similar to that for [&optional ("interactive" interactive)] def-body)) -(def-edebug-spec lambda-list - (([&rest arg] - [&optional ["&optional" arg &rest arg]] - &optional ["&rest" arg] - ))) +(def-edebug-elem-spec 'lambda-list + '(([&rest arg] + [&optional ["&optional" arg &rest arg]] + &optional ["&rest" arg] + ))) -(def-edebug-spec interactive - (&optional &or stringp def-form)) ; @r{Notice: @code{def-form}} +(def-edebug-elem-spec 'interactive + '(&optional &or stringp def-form)) ; @r{Notice: @code{def-form}} @end smallexample The specification for backquote below illustrates how to match @@ -1588,11 +1593,11 @@ could fail.) @smallexample (def-edebug-spec \` (backquote-form)) ; @r{Alias just for clarity.} -(def-edebug-spec backquote-form - (&or ([&or "," ",@@"] &or ("quote" backquote-form) form) - (backquote-form . [&or nil backquote-form]) - (vector &rest backquote-form) - sexp)) +(def-edebug-elem-spec 'backquote-form + '(&or ([&or "," ",@@"] &or ("quote" backquote-form) form) + (backquote-form . [&or nil backquote-form]) + (vector &rest backquote-form) + sexp)) @end smallexample @@ -1635,10 +1640,10 @@ option. @xref{Instrumenting}. @defopt edebug-eval-macro-args When this is non-@code{nil}, all macro arguments will be instrumented -in the generated code. For any macro, an @code{edebug-form-spec} +in the generated code. For any macro, the @code{debug} declaration overrides this option. So to specify exceptions for macros that have -some arguments evaluated and some not, use @code{def-edebug-spec} to -specify an @code{edebug-form-spec}. +some arguments evaluated and some not, use the @code{debug} declaration +specify an Edebug form specification. @end defopt @defopt edebug-save-windows diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 22f0dde593a..33f37331947 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -1125,7 +1125,7 @@ You don't need to give a directory or extension in the file name @var{library}. Normally, you just give a bare file name, like this: @example -(with-eval-after-load "edebug" (def-edebug-spec c-point t)) +(with-eval-after-load "js" (define-key js-mode-map "\C-c\C-c" 'js-eval)) @end example To restrict which files can trigger the evaluation, include a diff --git a/etc/NEWS b/etc/NEWS index fe626fec7ec..464b955ee74 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -938,6 +938,13 @@ To customize obsolete user options, use 'customize-option' or --- *** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. ++++ +*** New function 'def-edebug-elem-spec' to define Edebug spec elements. +These used to be defined with 'def-edebug-spec' thus conflating the +two name spaces, which lead to name collisions. +The use of 'def-edebug-spec' to define Edebug spec elements is +declared obsolete. + *** Edebug specification lists can use some new keywords: +++ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c312afe55b9..5967e0d084f 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -186,14 +186,14 @@ The name is made by appending a number to PREFIX, default \"T\"." ;;; Program structure. -(def-edebug-spec cl-declarations - (&rest ("cl-declare" &rest sexp))) +(def-edebug-elem-spec 'cl-declarations + '(&rest ("cl-declare" &rest sexp))) -(def-edebug-spec cl-declarations-or-string - (&or lambda-doc cl-declarations)) +(def-edebug-elem-spec 'cl-declarations-or-string + '(&or lambda-doc cl-declarations)) -(def-edebug-spec cl-lambda-list - (([&rest cl-lambda-arg] +(def-edebug-elem-spec 'cl-lambda-list + '(([&rest cl-lambda-arg] [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] [&optional ["&rest" cl-lambda-arg]] [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] @@ -202,27 +202,27 @@ The name is made by appending a number to PREFIX, default \"T\"." &or (cl-lambda-arg &optional def-form) arg]] . [&or arg nil]))) -(def-edebug-spec cl-&optional-arg - (&or (cl-lambda-arg &optional def-form arg) arg)) +(def-edebug-elem-spec 'cl-&optional-arg + '(&or (cl-lambda-arg &optional def-form arg) arg)) -(def-edebug-spec cl-&key-arg - (&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg)) +(def-edebug-elem-spec 'cl-&key-arg + '(&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg)) -(def-edebug-spec cl-lambda-arg - (&or arg cl-lambda-list1)) +(def-edebug-elem-spec 'cl-lambda-arg + '(&or arg cl-lambda-list1)) -(def-edebug-spec cl-lambda-list1 - (([&optional ["&whole" arg]] ;; only allowed at lower levels - [&rest cl-lambda-arg] - [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] - [&optional ["&rest" cl-lambda-arg]] - [&optional ["&key" cl-&key-arg &rest cl-&key-arg - &optional "&allow-other-keys"]] - [&optional ["&aux" &rest - &or (cl-lambda-arg &optional def-form) arg]] - . [&or arg nil]))) +(def-edebug-elem-spec 'cl-lambda-list1 + '(([&optional ["&whole" arg]] ;; only allowed at lower levels + [&rest cl-lambda-arg] + [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] + [&optional ["&rest" cl-lambda-arg]] + [&optional ["&key" cl-&key-arg &rest cl-&key-arg + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (cl-lambda-arg &optional def-form) arg]] + . [&or arg nil]))) -(def-edebug-spec cl-type-spec sexp) +(def-edebug-elem-spec 'cl-type-spec '(sexp)) (defconst cl--lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) @@ -390,39 +390,39 @@ and BODY is implicitly surrounded by (cl-block NAME ...). ;; Note that &environment is only allowed as first or last items in the ;; top level list. -(def-edebug-spec cl-macro-list - (([&optional "&environment" arg] - [&rest cl-macro-arg] - [&optional ["&optional" &rest - &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] - [&optional [[&or "&rest" "&body"] cl-macro-arg]] - [&optional ["&key" [&rest - [&or ([&or (symbolp cl-macro-arg) arg] - &optional def-form cl-macro-arg) - arg]] - &optional "&allow-other-keys"]] - [&optional ["&aux" &rest - &or (cl-macro-arg &optional def-form) arg]] - [&optional "&environment" arg] - ))) +(def-edebug-elem-spec 'cl-macro-list + '(([&optional "&environment" arg] + [&rest cl-macro-arg] + [&optional ["&optional" &rest + &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] + [&optional [[&or "&rest" "&body"] cl-macro-arg]] + [&optional ["&key" [&rest + [&or ([&or (symbolp cl-macro-arg) arg] + &optional def-form cl-macro-arg) + arg]] + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (cl-macro-arg &optional def-form) arg]] + [&optional "&environment" arg] + ))) -(def-edebug-spec cl-macro-arg - (&or arg cl-macro-list1)) +(def-edebug-elem-spec 'cl-macro-arg + '(&or arg cl-macro-list1)) -(def-edebug-spec cl-macro-list1 - (([&optional "&whole" arg] ;; only allowed at lower levels - [&rest cl-macro-arg] - [&optional ["&optional" &rest - &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] - [&optional [[&or "&rest" "&body"] cl-macro-arg]] - [&optional ["&key" [&rest - [&or ([&or (symbolp cl-macro-arg) arg] - &optional def-form cl-macro-arg) - arg]] - &optional "&allow-other-keys"]] - [&optional ["&aux" &rest - &or (cl-macro-arg &optional def-form) arg]] - . [&or arg nil]))) +(def-edebug-elem-spec 'cl-macro-list1 + '(([&optional "&whole" arg] ;; only allowed at lower levels + [&rest cl-macro-arg] + [&optional ["&optional" &rest + &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] + [&optional [[&or "&rest" "&body"] cl-macro-arg]] + [&optional ["&key" [&rest + [&or ([&or (symbolp cl-macro-arg) arg] + &optional def-form cl-macro-arg) + arg]] + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (cl-macro-arg &optional def-form) arg]] + . [&or arg nil]))) ;;;###autoload (defmacro cl-defmacro (name args &rest body) @@ -452,19 +452,19 @@ more details. (indent 2)) `(defmacro ,name ,@(cl--transform-lambda (cons args body) name))) -(def-edebug-spec cl-lambda-expr - (&define ("lambda" cl-lambda-list - cl-declarations-or-string - [&optional ("interactive" interactive)] - def-body))) +(def-edebug-elem-spec 'cl-lambda-expr + '(&define ("lambda" cl-lambda-list + cl-declarations-or-string + [&optional ("interactive" interactive)] + def-body))) ;; Redefine function-form to also match cl-function -(def-edebug-spec function-form +(def-edebug-elem-spec 'function-form ;; form at the end could also handle "function", ;; but recognize it specially to avoid wrapping function forms. - (&or ([&or "quote" "function"] &or symbolp lambda-expr) - ("cl-function" cl-function) - form)) + '(&or ([&or "quote" "function"] &or symbolp lambda-expr) + ("cl-function" cl-function) + form)) ;;;###autoload (defmacro cl-function (func) @@ -1051,20 +1051,20 @@ For more details, see Info node `(cl)Loop Facility'. ;; [&rest loop-clause] ;; )) -;; (def-edebug-spec loop-with -;; ("with" loop-var +;; (def-edebug-elem-spec 'loop-with +;; '("with" loop-var ;; loop-type-spec ;; [&optional ["=" form]] ;; &rest ["and" loop-var ;; loop-type-spec ;; [&optional ["=" form]]])) -;; (def-edebug-spec loop-for-as -;; ([&or "for" "as"] loop-for-as-subclause +;; (def-edebug-elem-spec 'loop-for-as +;; '([&or "for" "as"] loop-for-as-subclause ;; &rest ["and" loop-for-as-subclause])) -;; (def-edebug-spec loop-for-as-subclause -;; (loop-var +;; (def-edebug-elem-spec 'loop-for-as-subclause +;; '(loop-var ;; loop-type-spec ;; &or ;; [[&or "in" "on" "in-ref" "across-ref"] @@ -1124,19 +1124,19 @@ For more details, see Info node `(cl)Loop Facility'. ;; [&optional ["by" form]] ;; ])) -;; (def-edebug-spec loop-initial-final -;; (&or ["initially" +;; (def-edebug-elem-spec 'loop-initial-final +;; '(&or ["initially" ;; ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this. ;; &rest loop-non-atomic-expr] ;; ["finally" &or ;; [[&optional &or "do" "doing"] &rest loop-non-atomic-expr] ;; ["return" form]])) -;; (def-edebug-spec loop-and-clause -;; (loop-clause &rest ["and" loop-clause])) +;; (def-edebug-elem-spec 'loop-and-clause +;; '(loop-clause &rest ["and" loop-clause])) -;; (def-edebug-spec loop-clause -;; (&or +;; (def-edebug-elem-spec 'loop-clause +;; '(&or ;; [[&or "while" "until" "always" "never" "thereis"] form] ;; [[&or "collect" "collecting" @@ -1163,10 +1163,10 @@ For more details, see Info node `(cl)Loop Facility'. ;; loop-initial-final ;; )) -;; (def-edebug-spec loop-non-atomic-expr -;; ([¬ atom] form)) +;; (def-edebug-elem-spec 'loop-non-atomic-expr +;; '([¬ atom] form)) -;; (def-edebug-spec loop-var +;; (def-edebug-elem-spec 'loop-var ;; ;; The symbolp must be last alternative to recognize e.g. (a b . c) ;; ;; loop-var => ;; ;; (loop-var . [&or nil loop-var]) @@ -1175,13 +1175,13 @@ For more details, see Info node `(cl)Loop Facility'. ;; ;; (symbolp . (symbolp . [&or nil loop-var])) ;; ;; (symbolp . (symbolp . loop-var)) ;; ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp) -;; (&or (loop-var . [&or nil loop-var]) [gate symbolp])) +;; '(&or (loop-var . [&or nil loop-var]) [gate symbolp])) -;; (def-edebug-spec loop-type-spec -;; (&optional ["of-type" loop-d-type-spec])) +;; (def-edebug-elem-spec 'loop-type-spec +;; '(&optional ["of-type" loop-d-type-spec])) -;; (def-edebug-spec loop-d-type-spec -;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec)) +;; (def-edebug-elem-spec 'loop-d-type-spec +;; '(&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec)) (defun cl--parse-loop-clause () ; uses loop-* (let ((word (pop cl--loop-args)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 782299454ea..47b45614e71 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -261,6 +261,14 @@ The argument is usually a symbol, but it doesn't have to be." (define-obsolete-function-alias 'get-edebug-spec #'edebug-get-spec "28.1") +(defun edebug--get-elem-spec (elem) + "Return the specs of the Edebug element ELEM, if any. +ELEM has to be a symbol." + (or (get elem 'edebug-elem-spec) + ;; For backward compatibility, we also allow the use of + ;; a form's name as a shorthand to refer to its spec. + (edebug-get-spec elem))) + ;;;###autoload (defun edebug-basic-spec (spec) "Return t if SPEC uses only extant spec symbols. @@ -1757,16 +1765,11 @@ contains a circular object." (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. )) - ;; FIXME: We abuse `edebug-form-spec' here. It's normally used to store the - ;; specs for a given sexp's head, but here we use it to keep the - ;; function implementing of a given "core spec". - (put (car pair) 'edebug-form-spec (cdr pair))) + (put (car pair) 'edebug-elem-spec (cdr pair))) (defun edebug-match-symbol (cursor symbol) ;; Match a symbol spec. - ;; FIXME: We abuse `edebug-get-spec' here, passing it a *spec* rather than - ;; the head element of a source sexp. - (let* ((spec (edebug-get-spec symbol))) + (let* ((spec (edebug--get-elem-spec symbol))) (cond (spec (if (consp spec) @@ -2184,112 +2187,114 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." ;;;* Emacs special forms and some functions. -;; quote expects only one argument, although it allows any number. -(def-edebug-spec quote sexp) +(pcase-dolist + (`(,name ,spec) -;; The standard defining forms. -(def-edebug-spec defconst defvar) -(def-edebug-spec defvar (symbolp &optional form stringp)) + '((quote (sexp)) ;quote expects only one arg, tho it allows any number. -(def-edebug-spec defun - (&define name lambda-list lambda-doc - [&optional ("declare" &rest sexp)] - [&optional ("interactive" interactive)] - def-body)) -(def-edebug-spec defmacro - ;; FIXME: Improve `declare' so we can Edebug gv-expander and - ;; gv-setter declarations. - (&define name lambda-list lambda-doc - [&optional ("declare" &rest sexp)] def-body)) + ;; The standard defining forms. + (defvar (symbolp &optional form stringp)) + (defconst defvar) -(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list. + ;; Contrary to macros, special forms default to assuming that all args + ;; are normal forms, so we don't need to do anything about those + ;; special forms: + ;;(save-current-buffer t) + ;;(save-excursion t) + ;;... + ;;(progn t) -(def-edebug-spec lambda-list - (([&rest arg] - [&optional ["&optional" arg &rest arg]] - &optional ["&rest" arg] - ))) + ;; `defun' and `defmacro' are not special forms (any more), but it's + ;; more convenient to define their Edebug spec here. + (defun ( &define name lambda-list lambda-doc + [&optional ("declare" &rest sexp)] + [&optional ("interactive" &optional &or stringp def-form)] + def-body)) -(def-edebug-spec lambda-doc - (&optional [&or stringp - (&define ":documentation" def-form)])) + ;; FIXME: Improve `declare' so we can Edebug gv-expander and + ;; gv-setter declarations. + (defmacro ( &define name lambda-list lambda-doc + [&optional ("declare" &rest sexp)] + def-body)) -(def-edebug-spec interactive - (&optional &or stringp def-form)) + ;; function expects a symbol or a lambda or macro expression + ;; A macro is allowed by Emacs. + (function (&or symbolp lambda-expr)) + + ;; FIXME? The manual uses this form (maybe that's just + ;; for illustration purposes?): + ;; (let ((&rest &or symbolp (gate symbolp &optional form)) body)) + (let ((&rest &or (symbolp &optional form) symbolp) body)) + (let* let) + + (setq (&rest symbolp form)) + (cond (&rest (&rest form))) + + (condition-case ( symbolp form + &rest ([&or symbolp (&rest symbolp)] body))) + + (\` (backquote-form)) + + ;; Assume immediate quote in unquotes mean backquote at next + ;; higher level. + (\, (&or ("quote" edebug-\`) def-form)) + (\,@ (&define ;; so (,@ form) is never wrapped. + &or ("quote" edebug-\`) def-form)) + )) + (put name 'edebug-form-spec spec)) + +(def-edebug-elem-spec 'lambda-list + '(([&rest arg] + [&optional ["&optional" arg &rest arg]] + &optional ["&rest" arg] + ))) + +(def-edebug-elem-spec 'arglist '(lambda-list)) ;; deprecated - use lambda-list. + +(def-edebug-elem-spec 'lambda-doc + '(&optional [&or stringp + (&define ":documentation" def-form)])) ;; A function-form is for an argument that may be a function or a form. ;; This specially recognizes anonymous functions quoted with quote. -(def-edebug-spec function-form +(def-edebug-elem-spec 'function-form ;Deprecated, use `form'! ;; form at the end could also handle "function", ;; but recognize it specially to avoid wrapping function forms. - (&or ([&or "quote" "function"] &or symbolp lambda-expr) form)) - -;; function expects a symbol or a lambda or macro expression -;; A macro is allowed by Emacs. -(def-edebug-spec function (&or symbolp lambda-expr)) - -;; A macro expression is a lambda expression with "macro" prepended. -(def-edebug-spec macro (&define "lambda" lambda-list def-body)) - -;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro]))) - -;; Standard functions that take function-forms arguments. - -;; FIXME? The manual uses this form (maybe that's just for illustration?): -;; (def-edebug-spec let -;; ((&rest &or symbolp (gate symbolp &optional form)) -;; body)) -(def-edebug-spec let - ((&rest &or (symbolp &optional form) symbolp) - body)) - -(def-edebug-spec let* let) - -(def-edebug-spec setq (&rest symbolp form)) - -(def-edebug-spec cond (&rest (&rest form))) - -(def-edebug-spec condition-case - (symbolp - form - &rest ([&or symbolp (&rest symbolp)] body))) - - -(def-edebug-spec \` (backquote-form)) + '(&or ([&or "quote" "function"] &or symbolp lambda-expr) form)) ;; Supports quotes inside backquotes, ;; but only at the top level inside unquotes. -(def-edebug-spec backquote-form - (&or - ;; Disallow instrumentation of , and ,@ inside a nested backquote, since - ;; these are likely to be forms generated by a macro being debugged. - ("`" nested-backquote-form) - ([&or "," ",@"] &or ("quote" backquote-form) form) - ;; The simple version: - ;; (backquote-form &rest backquote-form) - ;; doesn't handle (a . ,b). The straightforward fix: - ;; (backquote-form . [&or nil backquote-form]) - ;; uses up too much stack space. - ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it. - (backquote-form [&rest [¬ ","] backquote-form] - . [&or nil backquote-form]) - ;; If you use dotted forms in backquotes, replace the previous line - ;; with the following. This takes quite a bit more stack space, however. - ;; (backquote-form . [&or nil backquote-form]) - (vector &rest backquote-form) - sexp)) +(def-edebug-elem-spec 'backquote-form + '(&or + ;; Disallow instrumentation of , and ,@ inside a nested backquote, since + ;; these are likely to be forms generated by a macro being debugged. + ("`" nested-backquote-form) + ([&or "," ",@"] &or ("quote" backquote-form) form) + ;; The simple version: + ;; (backquote-form &rest backquote-form) + ;; doesn't handle (a . ,b). The straightforward fix: + ;; (backquote-form . [&or nil backquote-form]) + ;; uses up too much stack space. + ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it. + (backquote-form [&rest [¬ ","] backquote-form] + . [&or nil backquote-form]) + ;; If you use dotted forms in backquotes, replace the previous line + ;; with the following. This takes quite a bit more stack space, however. + ;; (backquote-form . [&or nil backquote-form]) + (vector &rest backquote-form) + sexp)) -(def-edebug-spec nested-backquote-form - (&or - ("`" &error "Triply nested backquotes (without commas \"between\" them) \ +(def-edebug-elem-spec 'nested-backquote-form + '(&or + ("`" &error "Triply nested backquotes (without commas \"between\" them) \ are too difficult to instrument") - ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or - ;; (\,@ ...) matched on the next line. - ([&or "," ",@"] backquote-form) - (nested-backquote-form [&rest [¬ "," ",@"] nested-backquote-form] - . [&or nil nested-backquote-form]) - (vector &rest nested-backquote-form) - sexp)) + ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or + ;; (\,@ ...) matched on the next line. + ([&or "," ",@"] backquote-form) + (nested-backquote-form [&rest [¬ "," ",@"] nested-backquote-form] + . [&or nil nested-backquote-form]) + (vector &rest nested-backquote-form) + sexp)) ;; Special version of backquote that instruments backquoted forms ;; destined to be evaluated, usually as the result of a @@ -2304,20 +2309,9 @@ are too difficult to instrument") ;; ,@ might have some problems. -(defalias 'edebug-\` '\`) ;; same macro as regular backquote. -(def-edebug-spec edebug-\` (def-form)) - -;; Assume immediate quote in unquotes mean backquote at next higher level. -(def-edebug-spec \, (&or ("quote" edebug-\`) def-form)) -(def-edebug-spec \,@ (&define ;; so (,@ form) is never wrapped. - &or ("quote" edebug-\`) def-form)) - -;; New byte compiler. - -(def-edebug-spec save-selected-window t) -(def-edebug-spec save-current-buffer t) - -;; Anything else? +(defmacro edebug-\` (exp) + (declare (debug (def-form))) + (list '\` exp)) ;;; The debugger itself diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index d6c96c1ec82..5d428ac846a 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -62,15 +62,14 @@ (defvar pcase--dontwarn-upats '(pcase--dontcare)) -(def-edebug-spec pcase-PAT - (&or (&lookup symbolp pcase--get-edebug-spec) - sexp)) +(def-edebug-elem-spec 'pcase-PAT + '(&or (&lookup symbolp pcase--get-edebug-spec) sexp)) -(def-edebug-spec pcase-FUN - (&or lambda-expr - ;; Punt on macros/special forms. - (functionp &rest form) - sexp)) +(def-edebug-elem-spec 'pcase-FUN + '(&or lambda-expr + ;; Punt on macros/special forms. + (functionp &rest form) + sexp)) ;; Only called from edebug. (declare-function edebug-get-spec "edebug" (symbol)) @@ -925,13 +924,13 @@ Otherwise, it defers to REST which is a list of branches of the form (t (error "Unknown pattern `%S'" upat))))) (t (error "Incorrect MATCH %S" (car matches))))) -(def-edebug-spec pcase-QPAT +(def-edebug-elem-spec 'pcase-QPAT ;; Cf. edebug spec for `backquote-form' in edebug.el. - (&or ("," pcase-PAT) - (pcase-QPAT [&rest [¬ ","] pcase-QPAT] - . [&or nil pcase-QPAT]) - (vector &rest pcase-QPAT) - sexp)) + '(&or ("," pcase-PAT) + (pcase-QPAT [&rest [¬ ","] pcase-QPAT] + . [&or nil pcase-QPAT]) + (vector &rest pcase-QPAT) + sexp)) (pcase-defmacro \` (qpat) "Backquote-style pcase patterns: \\=`QPAT diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 48491e43cae..8a50fbef643 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -104,10 +104,10 @@ are integer buffer positions in the reverse order of the insertion order.") (defvar skeleton-point) (defvar skeleton-regions) -(def-edebug-spec skeleton-edebug-spec - ([&or null stringp (stringp &rest stringp) [[¬ atom] sexp]] - &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:" - ("quote" def-form) skeleton-edebug-spec def-form)) +(def-edebug-elem-spec 'skeleton-edebug-spec + '([&or null stringp (stringp &rest stringp) [[¬ atom] sexp]] + &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:" + ("quote" def-form) skeleton-edebug-spec def-form)) ;;;###autoload (defmacro define-skeleton (command documentation &rest skeleton) "Define a user-configurable COMMAND that enters a statement skeleton. diff --git a/lisp/subr.el b/lisp/subr.el index 454ea54b6a4..70ee281fe6e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -82,7 +82,7 @@ Testcover will raise an error." form) (defmacro def-edebug-spec (symbol spec) - "Set the `edebug-form-spec' property of SYMBOL according to SPEC. + "Set the Edebug SPEC to use for sexps which have SYMBOL as head. Both SYMBOL and SPEC are unevaluated. The SPEC can be: 0 (instrument no arguments); t (instrument all arguments); a symbol (naming a function with an Edebug specification); or a list. @@ -91,6 +91,21 @@ Info node `(elisp)Specification List' for details." (declare (indent 1)) `(put (quote ,symbol) 'edebug-form-spec (quote ,spec))) +(defun def-edebug-elem-spec (name spec) + "Define a new Edebug spec element NAME as shorthand for SPEC. +The SPEC has to be a list or a symbol. +The elements of the list describe the argument types; see +Info node `(elisp)Specification List' for details. +If SPEC is a symbol it should name another pre-existing Edebug element." + (declare (indent 1)) + (when (string-match "\\`[&:]" (symbol-name name)) + ;; & and : have special meaning in spec element names. + (error "Edebug spec name cannot start with '&' or ':'")) + (unless (consp spec) + (error "Edebug spec has to be a list: %S" spec)) + (put name 'edebug-elem-spec spec)) + + (defmacro lambda (&rest cdr) "Return an anonymous function. Under dynamic binding, a call of the form (lambda ARGS DOCSTRING diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index f8ca39c8c6e..d77df3c3c51 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -137,5 +137,15 @@ ,(cons func args)))) (wrap + 1 x))) +(defun edebug-test-code-cl-flet1 () + (cl-flet + ;; This `&rest' sexp head should not collide with + ;; the Edebug spec elem of the same name. + ((f (&rest x) x) + (gate (x) (+ x 5))) + ;; This call to `gate' shouldn't collide with the Edebug spec elem + ;; of the same name. + (message "Hi %s" (gate 7)))) + (provide 'edebug-test-code) ;;; edebug-test-code.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 6a6080df3c8..c11bfcf0012 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -954,6 +954,11 @@ primary ones (Bug#42671)." (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))") (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) +(ert-deftest edebug-tests--conflicting-internal-names () + "Check conflicts between form's head symbols and Edebug spec elements." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "cl-flet1" '(10) t))) + (ert-deftest edebug-tests-cl-flet () "Check that Edebug can instrument `cl-flet' forms without name clashes (Bug#41853)." From 24a98755ab7dd6b0805da02d040c9eb3bf5feac9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 13 Feb 2021 00:10:38 +0100 Subject: [PATCH 156/297] Remove outdated documentation from cperl-mode.el * lisp/progmodes/cperl-mode.el (cperl-tips, cperl-problems) (cperl-praise, cperl-speed, cperl-mode): Doc fixes; remove references to very old versions of Emacs and other "Emaxen". (cperl-problems-old-emaxen): Make obsolete and remove information on Emacs 20.3 and older. --- lisp/progmodes/cperl-mode.el | 69 +++++++----------------------------- 1 file changed, 12 insertions(+), 57 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 97d0e364644..167b2c6f33d 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -659,8 +659,8 @@ Run Perl/Tools/Insert-spaces-if-needed to fix your lazy typing. Switch auto-help on/off with Perl/Tools/Auto-help. -Though with contemporary Emaxen CPerl mode should maintain the correct -parsing of Perl even when editing, sometimes it may be lost. Fix this by +Though CPerl mode should maintain the correct parsing of Perl even when +editing, sometimes it may be lost. Fix this by \\[normal-mode] @@ -676,63 +676,20 @@ micro-docs on what I know about CPerl problems.") "Description of problems in CPerl mode. `fill-paragraph' on a comment may leave the point behind the paragraph. It also triggers a bug in some versions of Emacs (CPerl tries -to detect it and bulk out). - -See documentation of a variable `cperl-problems-old-emaxen' for the -problems which disappear if you upgrade Emacs to a reasonably new -version (20.3 for Emacs).") +to detect it and bulk out).") (defvar cperl-problems-old-emaxen 'please-ignore-this-line - "Description of problems in CPerl mode specific for older Emacs versions. - -Emacs had a _very_ restricted syntax parsing engine until version -20.1. Most problems below are corrected starting from this version of -Emacs, and all of them should be fixed in version 20.3. (Or apply -patches to Emacs 19.33/34 - see tips.) - -Note that even with newer Emacsen in some very rare cases the details -of interaction of `font-lock' and syntaxification may be not cleaned -up yet. You may get slightly different colors basing on the order of -fontification and syntaxification. Say, the initial faces is correct, -but editing the buffer breaks this. - -Even with older Emacsen CPerl mode tries to corrects some Emacs -misunderstandings, however, for efficiency reasons the degree of -correction is different for different operations. The partially -corrected problems are: POD sections, here-documents, regexps. The -operations are: highlighting, indentation, electric keywords, electric -braces. - -This may be confusing, since the regexp s#//#/#; may be highlighted -as a comment, but it will be recognized as a regexp by the indentation -code. Or the opposite case, when a POD section is highlighted, but -may break the indentation of the following code (though indentation -should work if the balance of delimiters is not broken by POD). - -The main trick (to make $ a \"backslash\") makes constructions like -${aaa} look like unbalanced braces. The only trick I can think of is -to insert it as $ {aaa} (valid in perl5, not in perl4). - -Similar problems arise in regexps, when /(\\s|$)/ should be rewritten -as /($|\\s)/. Note that such a transposition is not always possible. - -The solution is to upgrade your Emacs or patch an older one. Note -that Emacs 20.2 has some bugs related to `syntax-table' text -properties. Patches are available on the main CPerl download site, -and on CPAN. - -If these bugs cannot be fixed on your machine (say, you have an inferior -environment and cannot recompile), you may still disable all the fancy stuff -via `cperl-use-syntax-table-text-property'.") + "This used to contain a description of problems in CPerl mode +specific for very old Emacs versions. This is no longer relevant +and has been removed.") +(make-obsolete-variable 'cperl-problems-old-emaxen nil "28.1") (defvar cperl-praise 'please-ignore-this-line "Advantages of CPerl mode. 0) It uses the newest `syntax-table' property ;-); -1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl -mode - but the latter number may have improved too in last years) even -with old Emaxen which do not support `syntax-table' property. +1) It does 99% of Perl syntax correct. When using `syntax-table' property for syntax assist hints, it should handle 99.995% of lines correct - or somesuch. It automatically @@ -813,8 +770,7 @@ the settings present before the switch. 9) When doing indentation of control constructs, may correct line-breaks/spacing between elements of the construct. -10) Uses a linear-time algorithm for indentation of regions (on Emaxen with -capable syntax engines). +10) Uses a linear-time algorithm for indentation of regions. 11) Syntax-highlight, indentation, sexp-recognition inside regular expressions. ") @@ -838,8 +794,8 @@ syntax-parsing routines, and marks them up so that either A1) CPerl may work around these deficiencies (for big chunks, mostly PODs and HERE-documents), or - A2) On capable Emaxen CPerl will use improved syntax-handling - which reads mark-up hints directly. + A2) CPerl will use improved syntax-handling which reads mark-up + hints directly. The scan in case A2 is much more comprehensive, thus may be slower. @@ -1514,8 +1470,7 @@ span the needed amount of lines. Variables `cperl-pod-here-scan', `cperl-pod-here-fontify', `cperl-pod-face', `cperl-pod-head-face' control processing of POD and -here-docs sections. With capable Emaxen results of scan are used -for indentation too, otherwise they are used for highlighting only. +here-docs sections. Results of scan are used for indentation too. Variables controlling indentation style: `cperl-tab-always-indent' From 626911b704b3f144e9b8dbd187c394ed90e8411c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 13 Feb 2021 00:21:36 +0100 Subject: [PATCH 157/297] Comment out mysterious code from cperl-mode.el * lisp/progmodes/cperl-mode.el: Comment out mysterious code referring to some unknown variable 'edit-var-mode-alist'. No one seems to know what it is used for, so comment it out and see if anyone complains before Emacs 28.1 or 28.2. --- lisp/progmodes/cperl-mode.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 167b2c6f33d..0dffe279c39 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -975,9 +975,12 @@ versions of Emacs." "Abbrev table in use in CPerl mode buffers." :parents (list cperl-mode-electric-keywords-abbrev-table)) -(when (boundp 'edit-var-mode-alist) - ;; FIXME: What package uses this? - (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))) +;; ;; TODO: Commented out as we don't know what it is used for. If +;; ;; there are no bug reports about this for Emacs 28.1, this +;; ;; can probably be removed. (Code search online reveals nothing.) +;; (when (boundp 'edit-var-mode-alist) +;; ;; FIXME: What package uses this? +;; (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))) (defvar cperl-mode-map (let ((map (make-sparse-keymap))) From ca0842347e5437bcaeeded4a7fd55e0e48ed4bad Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 22:53:38 -0500 Subject: [PATCH 158/297] Edebug: Make it possible to debug `gv-expander`s in `declare` Arrange for declarations to be able to specify their own specs via the `edebug-declaration-spec` property. * lisp/emacs-lisp/edebug.el: (edebug--get-declare-spec): New function. (def-declarations): New spec element. (defun, defmacro): Use it in their spec. * lisp/emacs-lisp/gv.el (gv-expander, gv-setter): Set `edebug-declaration-spec`. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-gv-expander): New test. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-use-gv-expander): New test case. --- lisp/emacs-lisp/edebug.el | 12 ++++++++---- lisp/emacs-lisp/gv.el | 5 +++++ .../emacs-lisp/edebug-resources/edebug-test-code.el | 6 ++++++ test/lisp/emacs-lisp/edebug-tests.el | 11 +++++++++++ 4 files changed, 30 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 47b45614e71..394f47090ca 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2207,14 +2207,12 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." ;; `defun' and `defmacro' are not special forms (any more), but it's ;; more convenient to define their Edebug spec here. (defun ( &define name lambda-list lambda-doc - [&optional ("declare" &rest sexp)] + [&optional ("declare" def-declarations)] [&optional ("interactive" &optional &or stringp def-form)] def-body)) - ;; FIXME: Improve `declare' so we can Edebug gv-expander and - ;; gv-setter declarations. (defmacro ( &define name lambda-list lambda-doc - [&optional ("declare" &rest sexp)] + [&optional ("declare" def-declarations)] def-body)) ;; function expects a symbol or a lambda or macro expression @@ -2243,6 +2241,12 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." )) (put name 'edebug-form-spec spec)) +(defun edebug--get-declare-spec (head) + (get head 'edebug-declaration-spec)) + +(def-edebug-elem-spec 'def-declarations + '(&rest &or (&lookup symbolp edebug--get-declare-spec) sexp)) + (def-edebug-elem-spec 'lambda-list '(([&rest arg] [&optional ["&optional" arg &rest arg]] diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index c160aa1fd35..edacdf7f0c8 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -187,6 +187,11 @@ arguments as NAME. DO is a function as defined in `gv-get'." (push (list 'gv-setter #'gv--setter-defun-declaration) defun-declarations-alist)) +;;;###autoload +(let ((spec '(&or symbolp ("lambda" &define lambda-list def-body)))) + (put 'gv-expander 'edebug-declaration-spec spec) + (put 'gv-setter 'edebug-declaration-spec spec)) + ;; (defmacro gv-define-expand (name expander) ;; "Use EXPANDER to handle NAME as a generalized var. ;; NAME is a symbol: the name of a function, macro, or special form. diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index d77df3c3c51..835d3781d09 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -147,5 +147,11 @@ ;; of the same name. (message "Hi %s" (gate 7)))) +(defun edebug-test-code-use-gv-expander (x) + (declare (gv-expander + (lambda (do) + (funcall do `(car ,x) (lambda (v) `(setcar ,x ,v)))))) + (car x)) + (provide 'edebug-test-code) ;;; edebug-test-code.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index c11bfcf0012..dfe2cb32065 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -959,6 +959,17 @@ primary ones (Bug#42671)." (edebug-tests-with-normal-env (edebug-tests-setup-@ "cl-flet1" '(10) t))) +(ert-deftest edebug-tests-gv-expander () + "Edebug can instrument `gv-expander' expressions." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "use-gv-expander" nil t) + (should (equal + (catch 'text + (run-at-time 0 nil + (lambda () (throw 'text (buffer-substring (point) (+ (point) 5))))) + (eval '(setf (edebug-test-code-use-gv-expander (cons 'a 'b)) 3) t)) + "(func")))) + (ert-deftest edebug-tests-cl-flet () "Check that Edebug can instrument `cl-flet' forms without name clashes (Bug#41853)." From b4b9ecdfe366c64a7b95c4fd295b583c3f3c7aa9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 13 Feb 2021 05:18:55 +0100 Subject: [PATCH 159/297] Remove redundant :group args in progmodes/*.el * lisp/progmodes/bug-reference.el: * lisp/progmodes/cfengine.el: * lisp/progmodes/cmacexp.el: * lisp/progmodes/cpp.el: * lisp/progmodes/cwarn.el: * lisp/progmodes/dcl-mode.el: * lisp/progmodes/executable.el: * lisp/progmodes/flymake.el: * lisp/progmodes/gud.el: * lisp/progmodes/hideshow.el: * lisp/progmodes/icon.el: * lisp/progmodes/inf-lisp.el: * lisp/progmodes/js.el: * lisp/progmodes/ld-script.el: * lisp/progmodes/make-mode.el: * lisp/progmodes/modula2.el: * lisp/progmodes/pascal.el: * lisp/progmodes/perl-mode.el: * lisp/progmodes/prog-mode.el: * lisp/progmodes/simula.el: * lisp/progmodes/xscheme.el: Remove redundant :group args. --- lisp/progmodes/bug-reference.el | 3 +- lisp/progmodes/cfengine.el | 4 -- lisp/progmodes/cmacexp.el | 12 ++---- lisp/progmodes/cpp.el | 43 ++++++------------- lisp/progmodes/cwarn.el | 9 +--- lisp/progmodes/dcl-mode.el | 75 +++++++++++---------------------- lisp/progmodes/executable.el | 21 +++------ lisp/progmodes/flymake.el | 2 - lisp/progmodes/gud.el | 28 ++++-------- lisp/progmodes/hideshow.el | 7 +-- lisp/progmodes/icon.el | 21 +++------ lisp/progmodes/inf-lisp.el | 15 +++---- lisp/progmodes/js.el | 52 +++++++---------------- lisp/progmodes/ld-script.el | 3 +- lisp/progmodes/make-mode.el | 69 ++++++++++-------------------- lisp/progmodes/modula2.el | 15 +++---- lisp/progmodes/pascal.el | 30 +++++-------- lisp/progmodes/perl-mode.el | 4 +- lisp/progmodes/prog-mode.el | 6 +-- lisp/progmodes/simula.el | 33 +++++---------- lisp/progmodes/xscheme.el | 16 +++---- 21 files changed, 148 insertions(+), 320 deletions(-) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index a759394abeb..4d4becf780a 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -73,8 +73,7 @@ so that it is considered safe, see `enable-local-variables'.") "Regular expression matching bug references. The second subexpression should match the bug reference (usually a number)." :type 'regexp - :version "24.3" ; previously defconst - :group 'bug-reference) + :version "24.3") ; previously defconst ;;;###autoload (put 'bug-reference-bug-regexp 'safe-local-variable 'stringp) diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index f516664f7f4..bef99f2484b 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -69,7 +69,6 @@ (defcustom cfengine-indent 2 "Size of a CFEngine indentation step in columns." - :group 'cfengine :type 'integer) (defcustom cfengine-cf-promises @@ -86,7 +85,6 @@ Used for syntax discovery and checking. Set to nil to disable the `compile-command' override. In that case, the ElDoc support will use a fallback syntax definition." :version "24.4" - :group 'cfengine :type '(choice file (const nil))) (defcustom cfengine-parameters-indent '(promise pname 2) @@ -145,7 +143,6 @@ bundle agent rcfiles } " :version "24.4" - :group 'cfengine :type '(list (choice (const :tag "Anchor at beginning of promise" promise) (const :tag "Anchor at beginning of line" bol)) @@ -799,7 +796,6 @@ bundle agent rcfiles (defcustom cfengine-mode-abbrevs nil "Abbrevs for CFEngine2 mode." - :group 'cfengine :type '(repeat (list (string :tag "Name") (string :tag "Expansion") (choice :tag "Hook" (const nil) function)))) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 1a45b1cb838..820867ab41f 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -99,13 +99,11 @@ (defcustom c-macro-shrink-window-flag nil "Non-nil means shrink the *Macroexpansion* window to fit its contents." - :type 'boolean - :group 'c-macro) + :type 'boolean) (defcustom c-macro-prompt-flag nil "Non-nil makes `c-macro-expand' prompt for preprocessor arguments." - :type 'boolean - :group 'c-macro) + :type 'boolean) (defcustom c-macro-preprocessor (cond ;; Solaris has it in an unusual place. @@ -129,13 +127,11 @@ If you change this, be sure to preserve the `-C' (don't strip comments) option, or to set an equivalent one." - :type 'string - :group 'c-macro) + :type 'string) (defcustom c-macro-cppflags "" "Preprocessor flags used by `c-macro-expand'." - :type 'string - :group 'c-macro) + :type 'string) (defconst c-macro-buffer-name "*Macroexpansion*") diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index b2c2e8dab57..6602a79b2a4 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -53,8 +53,7 @@ (defcustom cpp-config-file (convert-standard-filename ".cpp.el") "File name to save cpp configuration." - :type 'file - :group 'cpp) + :type 'file) (define-widget 'cpp-face 'lazy "Either a face or the special symbol `invisible'." @@ -62,13 +61,11 @@ (defcustom cpp-known-face 'invisible "Face used for known cpp symbols." - :type 'cpp-face - :group 'cpp) + :type 'cpp-face) (defcustom cpp-unknown-face 'highlight "Face used for unknown cpp symbols." - :type 'cpp-face - :group 'cpp) + :type 'cpp-face) (defcustom cpp-face-type 'light "Indicate what background face type you prefer. @@ -76,18 +73,15 @@ Can be either light or dark for color screens, mono for monochrome screens, and none if you don't use a window system and don't have a color-capable display." :options '(light dark mono nil) - :type 'symbol - :group 'cpp) + :type 'symbol) (defcustom cpp-known-writable t "Non-nil means you are allowed to modify the known conditionals." - :type 'boolean - :group 'cpp) + :type 'boolean) (defcustom cpp-unknown-writable t "Non-nil means you are allowed to modify the unknown conditionals." - :type 'boolean - :group 'cpp) + :type 'boolean) (defcustom cpp-edit-list nil "Alist of cpp macros and information about how they should be displayed. @@ -101,15 +95,13 @@ Each entry is a list with the following elements: (cpp-face :tag "False") (choice (const :tag "True branch writable" t) (const :tag "False branch writable" nil) - (const :tag "Both branches writable" both)))) - :group 'cpp) + (const :tag "Both branches writable" both))))) (defcustom cpp-message-min-time-interval 1.0 "Minimum time interval in seconds for `cpp-progress-message' messages. If nil, `cpp-progress-message' prints no progress messages." :type '(choice (const :tag "Disable progress messages" nil) float) - :group 'cpp :version "26.1") (defvar-local cpp-overlay-list nil @@ -153,36 +145,31 @@ or a cons cell (background-color . COLOR)." :value-type (choice face (const invisible) (cons (const background-color) - (string :tag "Color")))) - :group 'cpp) + (string :tag "Color"))))) (defcustom cpp-face-light-name-list '("light gray" "light blue" "light cyan" "light yellow" "light pink" "pale green" "beige" "orange" "magenta" "violet" "medium purple" "turquoise") "Background colors useful with dark foreground colors." - :type '(repeat string) - :group 'cpp) + :type '(repeat string)) (defcustom cpp-face-dark-name-list '("dim gray" "blue" "cyan" "yellow" "red" "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple" "dark turquoise") "Background colors useful with light foreground colors." - :type '(repeat string) - :group 'cpp) + :type '(repeat string)) (defcustom cpp-face-light-list nil "Alist of names and faces to be used for light backgrounds." :type '(repeat (cons string (choice face - (cons (const background-color) string)))) - :group 'cpp) + (cons (const background-color) string))))) (defcustom cpp-face-dark-list nil "Alist of names and faces to be used for dark backgrounds." :type '(repeat (cons string (choice face - (cons (const background-color) string)))) - :group 'cpp) + (cons (const background-color) string))))) (defcustom cpp-face-mono-list '(("bold" . bold) @@ -190,15 +177,13 @@ or a cons cell (background-color . COLOR)." ("italic" . italic) ("underline" . underline)) "Alist of names and faces to be used for monochrome screens." - :type '(repeat (cons string face)) - :group 'cpp) + :type '(repeat (cons string face))) (defcustom cpp-face-none-list '(("default" . default) ("invisible" . invisible)) "Alist of names and faces available even if you don't use a window system." - :type '(repeat (cons string cpp-face)) - :group 'cpp) + :type '(repeat (cons string cpp-face))) (defvar cpp-face-all-list (append cpp-face-light-list diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 042030da396..63b344bea16 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -128,8 +128,7 @@ on one of three forms: See variable `cwarn-font-lock-feature-keywords-alist' for available features." - :type '(repeat sexp) - :group 'cwarn) + :type '(repeat sexp)) (defcustom cwarn-font-lock-feature-keywords-alist '((assign . cwarn-font-lock-assignment-keywords) @@ -142,15 +141,13 @@ keyword list." :type '(alist :key-type (choice (const assign) (const semicolon) (const reference)) - :value-type (sexp :tag "Value")) - :group 'cwarn) + :value-type (sexp :tag "Value"))) (defcustom cwarn-verbose t "When nil, CWarn mode will not generate any messages. Currently, messages are generated when the mode is activated and deactivated." - :group 'cwarn :type 'boolean) (defcustom cwarn-mode-text " CWarn" @@ -158,13 +155,11 @@ deactivated." \(When the string is not empty, make sure that it has a leading space.)" :tag "CWarn mode text" ; To separate it from `global-...' - :group 'cwarn :type 'string) (defcustom cwarn-load-hook nil "Functions to run when CWarn mode is first loaded." :tag "Load Hook" - :group 'cwarn :type 'hook) (make-obsolete-variable 'cwarn-load-hook "use `with-eval-after-load' instead." "28.1") diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index 8943d8b6d01..4a8a20a2969 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -97,8 +97,7 @@ dcl-block-begin-regexp and dcl-block-end-regexp. The meaning of this variable may be changed if dcl-calc-command-indent-function is set to a function." - :type 'integer - :group 'dcl) + :type 'integer) (defcustom dcl-continuation-offset 6 @@ -107,8 +106,7 @@ A continuation line is a line that follows a line ending with `-'. The meaning of this variable may be changed if dcl-calc-cont-indent-function is set to a function." - :type 'integer - :group 'dcl) + :type 'integer) (defcustom dcl-margin-offset 8 @@ -117,37 +115,32 @@ The first command line in a file or after a SUBROUTINE statement is indented this much. Other command lines are indented the same number of columns as the preceding command line. A command line is a line that starts with `$'." - :type 'integer - :group 'dcl) + :type 'integer) (defcustom dcl-margin-label-offset 2 "Number of columns to indent a margin label in DCL. A margin label is a label that doesn't begin or end a block, i.e. it doesn't match dcl-block-begin-regexp or dcl-block-end-regexp." - :type 'integer - :group 'dcl) + :type 'integer) (defcustom dcl-comment-line-regexp "^\\$!" "Regexp describing the start of a comment line in DCL. Comment lines are not indented." - :type 'regexp - :group 'dcl) + :type 'regexp) (defcustom dcl-block-begin-regexp "loop[0-9]*:" "Regexp describing a command that begins an indented block in DCL. Set to nil to only indent at THEN-ELSE-ENDIF." - :type 'regexp - :group 'dcl) + :type 'regexp) (defcustom dcl-block-end-regexp "endloop[0-9]*:" "Regexp describing a command that ends an indented block in DCL. Set to nil to only indent at THEN-ELSE-ENDIF." - :type 'regexp - :group 'dcl) + :type 'regexp) (defcustom dcl-calc-command-indent-function nil @@ -178,8 +171,7 @@ CUR-INDENT + EXTRA-INDENT. This package includes two functions suitable for this: dcl-calc-command-indent-multiple dcl-calc-command-indent-hang" - :type '(choice (const nil) function) - :group 'dcl) + :type '(choice (const nil) function)) (defcustom dcl-calc-cont-indent-function 'dcl-calc-cont-indent-relative @@ -196,8 +188,7 @@ CUR-INDENT + EXTRA-INDENT. This package includes one function suitable for this: dcl-calc-cont-indent-relative" - :type 'function - :group 'dcl) + :type 'function) (defcustom dcl-tab-always-indent t @@ -206,50 +197,41 @@ If t, pressing TAB always indents the current line. If nil, pressing TAB indents the current line if point is at the left margin. Data lines (i.e. lines not part of a command line or continuation line) are never indented." - :type 'boolean - :group 'dcl) + :type 'boolean) (defcustom dcl-electric-characters t "Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted." - :type 'boolean - :group 'dcl) + :type 'boolean) (defcustom dcl-tempo-comma ", " "Text to insert when a comma is needed in a template, in DCL mode." - :type 'string - :group 'dcl) + :type 'string) (defcustom dcl-tempo-left-paren "(" "Text to insert when a left parenthesis is needed in a template in DCL." - :type 'string - :group 'dcl) + :type 'string) (defcustom dcl-tempo-right-paren ")" "Text to insert when a right parenthesis is needed in a template in DCL." - :type 'string - :group 'dcl) + :type 'string) ; I couldn't decide what looked best, so I'll let you decide... ; Remember, you can also customize this with imenu-submenu-name-format. (defcustom dcl-imenu-label-labels "Labels" "Imenu menu title for sub-listing with label names." - :type 'string - :group 'dcl) + :type 'string) (defcustom dcl-imenu-label-goto "GOTO" "Imenu menu title for sub-listing with GOTO statements." - :type 'string - :group 'dcl) + :type 'string) (defcustom dcl-imenu-label-gosub "GOSUB" "Imenu menu title for sub-listing with GOSUB statements." - :type 'string - :group 'dcl) + :type 'string) (defcustom dcl-imenu-label-call "CALL" "Imenu menu title for sub-listing with CALL statements." - :type 'string - :group 'dcl) + :type 'string) (defcustom dcl-imenu-generic-expression `((nil "^\\$[ \t]*\\([A-Za-z0-9_$]+\\):[ \t]+SUBROUTINE\\b" 1) @@ -263,14 +245,12 @@ never indented." The default includes SUBROUTINE labels in the main listing and sub-listings for other labels, CALL, GOTO and GOSUB statements. See `imenu-generic-expression' for details." - :type '(repeat (sexp :tag "Imenu Expression")) - :group 'dcl) + :type '(repeat (sexp :tag "Imenu Expression"))) (defcustom dcl-mode-hook nil "Hook called by `dcl-mode'." - :type 'hook - :group 'dcl) + :type 'hook) ;;; *** Global variables **************************************************** @@ -354,16 +334,14 @@ See `imenu-generic-expression' for details." "Regular expression describing white space in a DCL command line. White space is any number of continued lines with only space,tab,endcomment followed by space or tab." - :type 'regexp - :group 'dcl) + :type 'regexp) (defcustom dcl-label-r "[a-zA-Z0-9_$]*:\\([ \t!]\\|$\\)" "Regular expression describing a label. A label is a name followed by a colon followed by white-space or end-of-line." - :type 'regexp - :group 'dcl) + :type 'regexp) (defcustom dcl-cmd-r @@ -373,8 +351,7 @@ A line starting with $, optionally followed by continuation lines, followed by the end of the command line. A continuation line is any characters followed by `-', optionally followed by a comment, followed by a newline." - :type 'regexp - :group 'dcl) + :type 'regexp) (defcustom dcl-command-regexp @@ -384,8 +361,7 @@ A line starting with $, optionally followed by continuation lines, followed by the end of the command line. A continuation line is any characters followed by `-', optionally followed by a comment, followed by a newline." - :type 'regexp - :group 'dcl) + :type 'regexp) (defcustom dcl-electric-reindent-regexps @@ -397,8 +373,7 @@ is defined as dcl-electric-character. E.g.: if this list contains `endif', the key `f' is defined as dcl-electric-character and you have just typed the `f' in `endif', the line will be reindented." - :type '(repeat regexp) - :group 'dcl) + :type '(repeat regexp)) (defvar dcl-option-alist diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index fa5724a3800..b1cd3303c5b 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -65,8 +65,7 @@ update the magic number." ;;; :type '(choice (const :tag "off" nil) ;;; (const :tag "on" t) ;;; symbol) - :type 'boolean - :group 'executable) + :type 'boolean) (defcustom executable-query 'function @@ -74,21 +73,18 @@ update the magic number." When this is `function', only ask when called non-interactively." :type '(choice (const :tag "Don't Ask" nil) (const :tag "Ask when non-interactive" function) - (other :tag "Ask" t)) - :group 'executable) + (other :tag "Ask" t))) (defcustom executable-magicless-file-regexp "/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$" "On files with this kind of name no magic is inserted or changed." - :type 'regexp - :group 'executable) + :type 'regexp) (defcustom executable-prefix "#!" "Interpreter magic number prefix inserted when there was no magic number. Use of `executable-prefix-env' is preferable to this option." :version "26.1" ; deprecated - :type 'string - :group 'executable) + :type 'string) (defcustom executable-prefix-env nil "If non-nil, use \"/usr/bin/env\" in interpreter magic number. @@ -96,8 +92,7 @@ If this variable is non-nil, the interpreter magic number inserted by `executable-set-magic' will be \"#!/usr/bin/env INTERPRETER\", otherwise it will be \"#!/path/to/INTERPRETER\"." :version "26.1" - :type 'boolean - :group 'executable) + :type 'boolean) (defcustom executable-chmod 73 "After saving, if the file is not executable, set this mode. @@ -105,8 +100,7 @@ This mode passed to `set-file-modes' is taken absolutely when negative, or relative to the files existing modes. Do nothing if this is nil. Typical values are 73 (+x) or -493 (rwxr-xr-x)." :type '(choice integer - (const nil)) - :group 'executable) + (const nil))) (defvar executable-command nil) @@ -114,8 +108,7 @@ Typical values are 73 (+x) or -493 (rwxr-xr-x)." (defcustom executable-self-display "tail" "Command you use with argument `-n+2' to make text files self-display. Note that the like of `more' doesn't work too well under Emacs \\[shell]." - :type 'string - :group 'executable) + :type 'string) (make-obsolete-variable 'executable-self-display nil "25.1" 'set) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 5d96c62b418..b8c8a827eed 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1198,7 +1198,6 @@ default) no filter is applied." '(" " flymake-mode-line-title flymake-mode-line-exception flymake-mode-line-counters) "Mode line construct for customizing Flymake information." - :group 'flymake :type '(repeat (choice string symbol))) (defcustom flymake-mode-line-counter-format @@ -1210,7 +1209,6 @@ default) no filter is applied." This is a suitable place for placing the `flymake-error-counter', `flymake-warning-counter' and `flymake-note-counter' constructs. Separating each of these with space is not necessary." - :group 'flymake :type '(repeat (choice string symbol))) (defvar flymake-mode-line-title '(:eval (flymake--mode-line-title)) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index eb114acdabc..b105cbaa0ef 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -64,8 +64,7 @@ pdb (Python), and jdb." (defcustom gud-key-prefix "\C-x\C-a" "Prefix of all GUD commands valid in C buffers." - :type 'key-sequence - :group 'gud) + :type 'key-sequence) (global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh) ;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack @@ -1074,8 +1073,7 @@ The file names should be absolute, or relative to the directory containing the executable being debugged." :type '(choice (const :tag "Current Directory" nil) (repeat :value ("") - directory)) - :group 'gud) + directory))) (defun gud-dbx-massage-args (_file args) (nconc (let ((directories gud-dbx-directories) @@ -1380,8 +1378,7 @@ The file names should be absolute, or relative to the directory containing the executable being debugged." :type '(choice (const :tag "Current Directory" nil) (repeat :value ("") - directory)) - :group 'gud) + directory))) (defun gud-xdb-massage-args (_file args) (nconc (let ((directories gud-xdb-directories) @@ -1563,8 +1560,7 @@ into one that invokes an Emacs-enabled debugging session. (defcustom gud-perldb-command-name "perl -d" "Default command to execute a Perl script under debugger." - :type 'string - :group 'gud) + :type 'string) ;;;###autoload (defun perldb (command-line) @@ -1677,8 +1673,7 @@ and source-file directory for your debugger." (if (executable-find "pdb") "pdb" "python -m pdb") "Command that executes the Python debugger." :version "27.1" - :type 'string - :group 'gud) + :type 'string) ;;;###autoload (defun pdb (command-line) @@ -1759,8 +1754,7 @@ directory and source-file directory for your debugger." "File name for executing the Guile debugger. This should be an executable on your path, or an absolute file name." :version "25.1" - :type 'string - :group 'gud) + :type 'string) ;;;###autoload (defun guiler (command-line) @@ -1883,8 +1877,7 @@ and source-file directory for your debugger." (defcustom gud-jdb-command-name "jdb" "Command that executes the Java debugger." - :type 'string - :group 'gud) + :type 'string) (defcustom gud-jdb-use-classpath t "If non-nil, search for Java source files in classpath directories. @@ -1899,8 +1892,7 @@ and parsing all Java files for class information. Set to nil to use `gud-jdb-directories' to scan java sources for class information on jdb startup (original method)." - :type 'boolean - :group 'gud) + :type 'boolean) (defvar gud-jdb-classpath nil "Java/jdb classpath directories list. @@ -2584,7 +2576,6 @@ Commands: (defcustom gud-chdir-before-run t "Non-nil if GUD should `cd' to the debugged executable." - :group 'gud :type 'boolean) ;; Perform initializations common to all debuggers. @@ -3419,7 +3410,6 @@ Treats actions as defuns." python-mode) "List of modes for which to enable GUD tooltips." :type '(repeat (symbol :tag "Major mode")) - :group 'gud :group 'tooltip) (defcustom gud-tooltip-display @@ -3431,13 +3421,11 @@ Forms in the list are combined with AND. The default is to display only tooltips in the buffer containing the overlay arrow." :type 'sexp :risky t - :group 'gud :group 'tooltip) (defcustom gud-tooltip-echo-area nil "Use the echo area instead of frames for GUD tooltips." :type 'boolean - :group 'gud :group 'tooltip) (make-obsolete-variable 'gud-tooltip-echo-area diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 73d09e00591..81ba0d86954 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -232,13 +232,11 @@ (defcustom hs-hide-comments-when-hiding-all t "Hide the comments too when you do an `hs-hide-all'." - :type 'boolean - :group 'hideshow) + :type 'boolean) (defcustom hs-minor-mode-hook nil "Hook called when hideshow minor mode is activated or deactivated." :type 'hook - :group 'hideshow :version "21.1") (defcustom hs-isearch-open 'code @@ -254,8 +252,7 @@ This has effect only if `search-invisible' is set to `open'." :type '(choice (const :tag "open only code blocks" code) (const :tag "open only comment blocks" comment) (const :tag "open both code and comment blocks" t) - (const :tag "don't open any of them" nil)) - :group 'hideshow) + (const :tag "don't open any of them" nil))) ;;;###autoload (defvar hs-special-modes-alist diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index 933cb333dfb..a36f020439d 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -86,42 +86,35 @@ (defcustom icon-indent-level 4 "Indentation of Icon statements with respect to containing block." - :type 'integer - :group 'icon) + :type 'integer) (defcustom icon-brace-imaginary-offset 0 "Imagined indentation of an Icon open brace that actually follows a statement." - :type 'integer - :group 'icon) + :type 'integer) (defcustom icon-brace-offset 0 "Extra indentation for braces, compared with other text in same context." - :type 'integer - :group 'icon) + :type 'integer) (defcustom icon-continued-statement-offset 4 "Extra indent for Icon lines not starting new statements." - :type 'integer - :group 'icon) + :type 'integer) (defcustom icon-continued-brace-offset 0 "Extra indent for Icon substatements that start with open-braces. This is in addition to `icon-continued-statement-offset'." - :type 'integer - :group 'icon) + :type 'integer) (defcustom icon-auto-newline nil "Non-nil means automatically newline before and after braces Icon code. This applies when braces are inserted." - :type 'boolean - :group 'icon) + :type 'boolean) (defcustom icon-tab-always-indent t "Non-nil means TAB in Icon mode should always reindent the current line. It will then reindent, regardless of where in the line point is when the TAB command is used." - :type 'boolean - :group 'icon) + :type 'boolean) (defvar icon-imenu-generic-expression '((nil "^[ \t]*procedure[ \t]+\\(\\sw+\\)[ \t]*(" 1)) diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index ac230596240..146ed4dca4a 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -76,8 +76,7 @@ Input matching this regexp is not saved on the input history in Inferior Lisp mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword \(as in :a, :c, etc.)" - :type 'regexp - :group 'inferior-lisp) + :type 'regexp) (defvar inferior-lisp-mode-map (let ((map (copy-keymap comint-mode-map))) @@ -155,8 +154,7 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword (defcustom inferior-lisp-program "lisp" "Program name for invoking an inferior Lisp in Inferior Lisp mode." - :type 'string - :group 'inferior-lisp) + :type 'string) (defcustom inferior-lisp-load-command "(load \"%s\")\n" "Format-string for building a Lisp expression to load a file. @@ -166,8 +164,7 @@ to load that file. The default works acceptably on most Lisps. The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\" produces cosmetically superior output for this application, but it works only in Common Lisp." - :type 'string - :group 'inferior-lisp) + :type 'string) (defcustom inferior-lisp-prompt "^[^> \n]*>+:? *" "Regexp to recognize prompts in the Inferior Lisp mode. @@ -182,8 +179,7 @@ More precise choices: Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" kcl: \"^>+ *\"" - :type 'regexp - :group 'inferior-lisp) + :type 'regexp) (defvar inferior-lisp-buffer nil "*The current inferior-lisp process buffer. @@ -487,8 +483,7 @@ describing the last `lisp-load-file' or `lisp-compile-file' command.") If it's loaded into a buffer that is in one of these major modes, it's considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'. Used by these commands to determine defaults." - :type '(repeat symbol) - :group 'inferior-lisp) + :type '(repeat symbol)) (defun lisp-load-file (file-name) "Load a Lisp file into the inferior Lisp process." diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index cdf6536fc7e..21bda086801 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -427,22 +427,19 @@ Match group 1 is the name of the macro.") (defcustom js-indent-level 4 "Number of spaces for each indentation step in `js-mode'." :type 'integer - :safe 'integerp - :group 'js) + :safe 'integerp) (defcustom js-expr-indent-offset 0 "Number of additional spaces for indenting continued expressions. The value must be no less than minus `js-indent-level'." :type 'integer - :safe 'integerp - :group 'js) + :safe 'integerp) (defcustom js-paren-indent-offset 0 "Number of additional spaces for indenting expressions in parentheses. The value must be no less than minus `js-indent-level'." :type 'integer :safe 'integerp - :group 'js :version "24.1") (defcustom js-square-indent-offset 0 @@ -450,7 +447,6 @@ The value must be no less than minus `js-indent-level'." The value must be no less than minus `js-indent-level'." :type 'integer :safe 'integerp - :group 'js :version "24.1") (defcustom js-curly-indent-offset 0 @@ -458,7 +454,6 @@ The value must be no less than minus `js-indent-level'." The value must be no less than minus `js-indent-level'." :type 'integer :safe 'integerp - :group 'js :version "24.1") (defcustom js-switch-indent-offset 0 @@ -466,26 +461,22 @@ The value must be no less than minus `js-indent-level'." The value must not be negative." :type 'integer :safe 'integerp - :group 'js :version "24.4") (defcustom js-flat-functions nil "Treat nested functions as top-level functions in `js-mode'. This applies to function movement, marking, and so on." - :type 'boolean - :group 'js) + :type 'boolean) (defcustom js-indent-align-list-continuation t "Align continuation of non-empty ([{ lines in `js-mode'." :version "26.1" :type 'boolean - :safe 'booleanp - :group 'js) + :safe 'booleanp) (defcustom js-comment-lineup-func #'c-lineup-C-comments "Lineup function for `cc-mode-style', for C comments in `js-mode'." - :type 'function - :group 'js) + :type 'function) (defcustom js-enabled-frameworks js--available-frameworks "Frameworks recognized by `js-mode'. @@ -493,30 +484,26 @@ To improve performance, you may turn off some frameworks you seldom use, either globally or on a per-buffer basis." :type (cons 'set (mapcar (lambda (x) (list 'const x)) - js--available-frameworks)) - :group 'js) + js--available-frameworks))) (defcustom js-js-switch-tabs (and (memq system-type '(darwin)) t) "Whether `js-mode' should display tabs while selecting them. This is useful only if the windowing system has a good mechanism for preventing Firefox from stealing the keyboard focus." - :type 'boolean - :group 'js) + :type 'boolean) (defcustom js-js-tmpdir "~/.emacs.d/js/js" "Temporary directory used by `js-mode' to communicate with Mozilla. This directory must be readable and writable by both Mozilla and Emacs." - :type 'directory - :group 'js) + :type 'directory) (defcustom js-js-timeout 5 "Reply timeout for executing commands in Mozilla via `js-mode'. The value is given in seconds. Increase this value if you are getting timeout messages." - :type 'integer - :group 'js) + :type 'integer) (defcustom js-indent-first-init nil "Non-nil means specially indent the first variable declaration's initializer. @@ -557,8 +544,7 @@ don't indent the first one's initializer; otherwise, indent it. bar = 2;" :version "25.1" :type '(choice (const nil) (const t) (const dynamic)) - :safe 'symbolp - :group 'js) + :safe 'symbolp) (defcustom js-chain-indent nil "Use \"chained\" indentation. @@ -571,8 +557,7 @@ then the \".\"s will be lined up: " :version "26.1" :type 'boolean - :safe 'booleanp - :group 'js) + :safe 'booleanp) (defcustom js-jsx-detect-syntax t "When non-nil, automatically detect whether JavaScript uses JSX. @@ -581,8 +566,7 @@ t. The detection strategy can be customized by adding elements to `js-jsx-regexps', which see." :version "27.1" :type 'boolean - :safe 'booleanp - :group 'js) + :safe 'booleanp) (defcustom js-jsx-syntax nil "When non-nil, parse JavaScript with consideration for JSX syntax. @@ -600,8 +584,7 @@ When `js-mode' is already enabled, you should call It is set to be buffer-local (and t) when in `js-jsx-mode'." :version "27.1" :type 'boolean - :safe 'booleanp - :group 'js) + :safe 'booleanp) (defcustom js-jsx-align->-with-< t "When non-nil, “>” will be indented to the opening “<” in JSX. @@ -625,8 +608,7 @@ When this is disabled, JSX indentation looks like this: />" :version "27.1" :type 'boolean - :safe 'booleanp - :group 'js) + :safe 'booleanp) (defcustom js-jsx-indent-level nil "When non-nil, indent JSX by this value, instead of like JS. @@ -655,8 +637,7 @@ indentation looks like this (different): :version "27.1" :type '(choice integer (const :tag "Not Set" nil)) - :safe (lambda (x) (or (null x) (integerp x))) - :group 'js) + :safe (lambda (x) (or (null x) (integerp x)))) ;; This is how indentation behaved out-of-the-box until Emacs 27. JSX ;; indentation was controlled with `sgml-basic-offset', which defaults ;; to 2, whereas `js-indent-level' defaults to 4. Users who had the @@ -685,8 +666,7 @@ indentation looks like this: This variable is like `sgml-attribute-offset'." :version "27.1" :type 'integer - :safe 'integerp - :group 'js) + :safe 'integerp) ;;; KeyMap diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index c4ea8e158d8..485e64e2492 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -35,8 +35,7 @@ (defvar ld-script-location-counter-face 'ld-script-location-counter) (defface ld-script-location-counter '((t :weight bold :inherit font-lock-builtin-face)) - "Face for location counter in GNU ld script." - :group 'ld-script) + "Face for location counter in GNU ld script.") ;; Syntax rules (defvar ld-script-mode-syntax-table diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index e382d6edcd2..3d1e7d634a2 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -101,14 +101,12 @@ (defface makefile-space '((((class color)) (:background "hotpink")) (t (:reverse-video t))) - "Face to use for highlighting leading spaces in Font-Lock mode." - :group 'makefile) + "Face to use for highlighting leading spaces in Font-Lock mode.") (defface makefile-targets ;; This needs to go along both with foreground and background colors (i.e. shell) '((t (:inherit font-lock-function-name-face))) "Face to use for additionally highlighting rule targets in Font-Lock mode." - :group 'makefile :version "22.1") (defface makefile-shell @@ -116,7 +114,6 @@ ;;'((((class color) (min-colors 88) (background light)) (:background "seashell1")) ;; (((class color) (min-colors 88) (background dark)) (:background "seashell4"))) "Face to use for additionally highlighting Shell commands in Font-Lock mode." - :group 'makefile :version "22.1") (defface makefile-makepp-perl @@ -124,19 +121,16 @@ (((class color) (background dark)) (:background "DarkBlue")) (t (:reverse-video t))) "Face to use for additionally highlighting Perl code in Font-Lock mode." - :group 'makefile :version "22.1") (defcustom makefile-browser-buffer-name "*Macros and Targets*" "Name of the macro- and target browser buffer." - :type 'string - :group 'makefile) + :type 'string) (defcustom makefile-target-colon ":" "String to append to all target names inserted by `makefile-insert-target'. \":\" or \"::\" are common values." - :type 'string - :group 'makefile) + :type 'string) (defcustom makefile-macro-assign " = " "String to append to all macro names inserted by `makefile-insert-macro'. @@ -144,70 +138,58 @@ The normal value should be \" = \", since this is what standard make expects. However, newer makes such as dmake allow a larger variety of different macro assignments, so you might prefer to use \" += \" or \" := \" ." - :type 'string - :group 'makefile) + :type 'string) (defcustom makefile-electric-keys nil "If non-nil, Makefile mode should install electric keybindings. Default is nil." - :type 'boolean - :group 'makefile) + :type 'boolean) (defcustom makefile-use-curly-braces-for-macros-p nil "Controls the style of generated macro references. Non-nil means macro references should use curly braces, like `${this}'. nil means use parentheses, like `$(this)'." - :type 'boolean - :group 'makefile) + :type 'boolean) (defcustom makefile-tab-after-target-colon t "If non-nil, insert a TAB after a target colon. Otherwise, a space is inserted. The default is t." - :type 'boolean - :group 'makefile) + :type 'boolean) (defcustom makefile-browser-leftmost-column 10 "Number of blanks to the left of the browser selection mark." - :type 'integer - :group 'makefile) + :type 'integer) (defcustom makefile-browser-cursor-column 10 "Column the cursor goes to when it moves up or down in the Makefile browser." - :type 'integer - :group 'makefile) + :type 'integer) (defcustom makefile-backslash-column 48 "Column in which `makefile-backslash-region' inserts backslashes." - :type 'integer - :group 'makefile) + :type 'integer) (defcustom makefile-backslash-align t "If non-nil, `makefile-backslash-region' will align backslashes." - :type 'boolean - :group 'makefile) + :type 'boolean) (defcustom makefile-browser-selected-mark "+ " "String used to mark selected entries in the Makefile browser." - :type 'string - :group 'makefile) + :type 'string) (defcustom makefile-browser-unselected-mark " " "String used to mark unselected entries in the Makefile browser." - :type 'string - :group 'makefile) + :type 'string) (defcustom makefile-browser-auto-advance-after-selection-p t "If non-nil, cursor will move after item is selected in Makefile browser." - :type 'boolean - :group 'makefile) + :type 'boolean) (defcustom makefile-pickup-everything-picks-up-filenames-p nil "If non-nil, `makefile-pickup-everything' picks up filenames as targets. This means it calls `makefile-pickup-filenames-as-targets'. Otherwise filenames are omitted." - :type 'boolean - :group 'makefile) + :type 'boolean) (defcustom makefile-cleanup-continuations nil "If non-nil, automatically clean up continuation lines when saving. @@ -215,13 +197,11 @@ A line is cleaned up by removing all whitespace following a trailing backslash. This is done silently. IMPORTANT: Please note that enabling this option causes Makefile mode to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"." - :type 'boolean - :group 'makefile) + :type 'boolean) (defcustom makefile-mode-hook nil "Normal hook run by `makefile-mode'." - :type 'hook - :group 'makefile) + :type 'hook) (defvar makefile-browser-hook '()) @@ -240,8 +220,7 @@ to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"." "List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a \".\" at the beginning of a line in `makefile-mode'." - :type '(repeat string) - :group 'makefile) + :type '(repeat string)) (put 'makefile-special-targets-list 'risky-local-variable t) (defcustom makefile-runtime-macros-list @@ -250,8 +229,7 @@ you enter a \".\" at the beginning of a line in `makefile-mode'." If you insert a macro reference using `makefile-insert-macro-ref', the name of the macro is checked against this list. If it can be found its name will not be enclosed in { } or ( )." - :type '(repeat (list string)) - :group 'makefile) + :type '(repeat (list string))) ;; Note that the first big subexpression is used by font lock. Note ;; that if you change this regexp you might have to fix the imenu @@ -563,8 +541,7 @@ not be enclosed in { } or ( )." (defcustom makefile-brave-make "make" "How to invoke make, for `makefile-query-targets'. This should identify a `make' command that can handle the `-q' option." - :type 'string - :group 'makefile) + :type 'string) (defvaralias 'makefile-query-one-target-method 'makefile-query-one-target-method-function) @@ -584,13 +561,11 @@ The function must satisfy this calling convention: * It must return the integer value 0 (zero) if the given target should be considered up-to-date in the context of the given makefile, any nonzero integer value otherwise." - :type 'function - :group 'makefile) + :type 'function) (defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*" "Name of the Up-to-date overview buffer." - :type 'string - :group 'makefile) + :type 'string) ;;; --- end of up-to-date-overview configuration ------------------ diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index a77a4e2b216..536d3be0056 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -51,23 +51,19 @@ (defcustom m2-compile-command "m2c" "Command to compile Modula-2 programs." - :type 'string - :group 'modula2) + :type 'string) (defcustom m2-link-command "m2l" "Command to link Modula-2 programs." - :type 'string - :group 'modula2) + :type 'string) (defcustom m2-link-name nil "Name of the Modula-2 executable." - :type '(choice (const nil) string) - :group 'modula2) + :type '(choice (const nil) string)) (defcustom m2-end-comment-column 75 "Column for aligning the end of a comment, in Modula-2." - :type 'integer - :group 'modula2) + :type 'integer) ;;; Added by TEP (defvar m2-mode-map @@ -105,8 +101,7 @@ (defcustom m2-indent 5 "This variable gives the indentation in Modula-2 mode." - :type 'integer - :group 'modula2) + :type 'integer) (put 'm2-indent 'safe-local-variable (lambda (v) (or (null v) (integerp v)))) diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 59f90d7293b..e6e6e40aa19 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -199,38 +199,32 @@ (defcustom pascal-indent-level 3 "Indentation of Pascal statements with respect to containing block." - :type 'integer - :group 'pascal) + :type 'integer) (defcustom pascal-case-indent 2 "Indentation for case statements." - :type 'integer - :group 'pascal) + :type 'integer) (defcustom pascal-auto-newline nil "Non-nil means automatically insert newlines in certain cases. These include after semicolons and after the punctuation mark after an `end'." - :type 'boolean - :group 'pascal) + :type 'boolean) (defcustom pascal-indent-nested-functions t "Non-nil means nested functions are indented." - :type 'boolean - :group 'pascal) + :type 'boolean) (defcustom pascal-tab-always-indent t "Non-nil means TAB in Pascal mode should always reindent the current line. If this is nil, TAB inserts a tab if it is at the end of the line and follows non-whitespace text." - :type 'boolean - :group 'pascal) + :type 'boolean) (defcustom pascal-auto-endcomments t "Non-nil means automatically insert comments after certain `end's. Specifically, this is done after the ends of case statements and functions. The name of the function or case is included between the braces." - :type 'boolean - :group 'pascal) + :type 'boolean) (defcustom pascal-auto-lineup '(all) "List of contexts where auto lineup of :'s or ='s should be done. @@ -243,8 +237,7 @@ will do all lineups." (const :tag "Everything" all) (const :tag "Parameter lists" paramlist) (const :tag "Declarations" declaration) - (const :tag "Case statements" case)) - :group 'pascal) + (const :tag "Case statements" case))) (defvar pascal-toggle-completions nil "If non-nil, `pascal-complete-word' tries all possible completions. @@ -260,8 +253,7 @@ completions.") These include integer, real, char, etc. The types defined within the Pascal program are handled in another way, and should not be added to this list." - :type '(repeat (string :tag "Keyword")) - :group 'pascal) + :type '(repeat (string :tag "Keyword"))) (defcustom pascal-start-keywords '("begin" "end" "function" "procedure" "repeat" "until" "while" @@ -270,8 +262,7 @@ are handled in another way, and should not be added to this list." These are keywords such as begin, repeat, until, readln. The procedures and variables defined within the Pascal program are handled in another way, and should not be added to this list." - :type '(repeat (string :tag "Keyword")) - :group 'pascal) + :type '(repeat (string :tag "Keyword"))) (defcustom pascal-separator-keywords '("downto" "else" "mod" "div" "then") @@ -279,8 +270,7 @@ are handled in another way, and should not be added to this list." These are keywords such as downto, else, mod, then. Variables and function names defined within the Pascal program are handled in another way, and should not be added to this list." - :type '(repeat (string :tag "Keyword")) - :group 'pascal) + :type '(repeat (string :tag "Keyword"))) ;;; diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 0120e4a7cd1..c7fa5ab84b0 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -98,8 +98,7 @@ (defface perl-non-scalar-variable '((t :inherit font-lock-variable-name-face :underline t)) "Face used for non-scalar variables." - :version "28.1" - :group 'perl) + :version "28.1") (defvar perl-mode-abbrev-table nil "Abbrev table in use in perl-mode buffers.") @@ -640,7 +639,6 @@ This is a non empty list of strings, the checker tool possibly followed by required arguments. Once launched it will receive the Perl source to be checked as its standard input." :version "26.1" - :group 'perl :type '(repeat string)) (defvar-local perl--flymake-proc nil) diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index d88d3505586..19de7545bf3 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -41,8 +41,7 @@ :type 'hook :options '(flyspell-prog-mode abbrev-mode flymake-mode display-line-numbers-mode - prettify-symbols-mode) - :group 'prog-mode) + prettify-symbols-mode)) (defvar prog-mode-map (let ((map (make-sparse-keymap))) @@ -166,8 +165,7 @@ on the symbol." :version "25.1" :type '(choice (const :tag "Never unprettify" nil) (const :tag "Unprettify when point is inside" t) - (const :tag "Unprettify when point is inside or at right edge" right-edge)) - :group 'prog-mode) + (const :tag "Unprettify when point is inside or at right edge" right-edge))) (defun prettify-symbols--post-command-hook () (cl-labels ((get-prop-as-list diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index a863e7eb4b4..fab600f83f4 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -51,16 +51,14 @@ the run of whitespace at the beginning of the line.") "Non-nil means TAB in SIMULA mode should always reindent the current line. Otherwise TAB indents only when point is within the run of whitespace at the beginning of the line." - :type 'boolean - :group 'simula) + :type 'boolean) (defconst simula-indent-level-default 3 "Indentation of SIMULA statements with respect to containing block.") (defcustom simula-indent-level simula-indent-level-default "Indentation of SIMULA statements with respect to containing block." - :type 'integer - :group 'simula) + :type 'integer) (defconst simula-substatement-offset-default 3 @@ -68,8 +66,7 @@ the run of whitespace at the beginning of the line." (defcustom simula-substatement-offset simula-substatement-offset-default "Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE." - :type 'integer - :group 'simula) + :type 'integer) (defconst simula-continued-statement-offset-default 3 "Extra indentation for lines not starting a statement or substatement. @@ -83,16 +80,14 @@ the previous line of the statement.") If value is a list, each line in a multipleline continued statement will have the car of the list extra indentation with respect to the previous line of the statement." - :type 'integer - :group 'simula) + :type 'integer) (defconst simula-label-offset-default -4711 "Offset of SIMULA label lines relative to usual indentation.") (defcustom simula-label-offset simula-label-offset-default "Offset of SIMULA label lines relative to usual indentation." - :type 'integer - :group 'simula) + :type 'integer) (defconst simula-if-indent-default '(0 . 0) "Extra indentation of THEN and ELSE with respect to the starting IF. @@ -103,8 +98,7 @@ extra ELSE indentation. IF after ELSE is indented as the starting IF.") "Extra indentation of THEN and ELSE with respect to the starting IF. Value is a cons cell, the car is extra THEN indentation and the cdr extra ELSE indentation. IF after ELSE is indented as the starting IF." - :type '(cons integer integer) - :group 'simula) + :type '(cons integer integer)) (defconst simula-inspect-indent-default '(0 . 0) "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT. @@ -115,16 +109,14 @@ and the cdr extra OTHERWISE indentation.") "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT. Value is a cons cell, the car is extra WHEN indentation and the cdr extra OTHERWISE indentation." - :type '(cons integer integer) - :group 'simula) + :type '(cons integer integer)) (defconst simula-electric-indent-default nil "Non-nil means `simula-indent-line' function may reindent previous line.") (defcustom simula-electric-indent simula-electric-indent-default "Non-nil means `simula-indent-line' function may reindent previous line." - :type 'boolean - :group 'simula) + :type 'boolean) (defconst simula-abbrev-keyword-default 'upcase "Specify how to convert case for SIMULA keywords. @@ -135,8 +127,7 @@ Value is one of the symbols `upcase', `downcase', `capitalize', "Specify how to convert case for SIMULA keywords. Value is one of the symbols `upcase', `downcase', `capitalize', \(as in) `abbrev-table' or nil if they should not be changed." - :type '(choice (const upcase) (const downcase) (const capitalize)(const nil)) - :group 'simula) + :type '(choice (const upcase) (const downcase) (const capitalize)(const nil))) (defconst simula-abbrev-stdproc-default 'abbrev-table "Specify how to convert case for standard SIMULA procedure and class names. @@ -148,16 +139,14 @@ Value is one of the symbols `upcase', `downcase', `capitalize', Value is one of the symbols `upcase', `downcase', `capitalize', \(as in) `abbrev-table', or nil if they should not be changed." :type '(choice (const upcase) (const downcase) (const capitalize) - (const abbrev-table) (const nil)) - :group 'simula) + (const abbrev-table) (const nil))) (defcustom simula-abbrev-file nil "File with extra abbrev definitions for use in SIMULA mode. These are used together with the standard abbrev definitions for SIMULA. Please note that the standard definitions are required for SIMULA mode to function correctly." - :type '(choice file (const nil)) - :group 'simula) + :type '(choice file (const nil))) (defvar simula-mode-syntax-table nil "Syntax table in SIMULA mode buffers.") diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index e85e3cfdbbd..613863dd613 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -104,20 +104,17 @@ reading-string reading prompt string") (defcustom scheme-band-name nil "Band loaded by the `run-scheme' command." - :type '(choice (const nil) string) - :group 'xscheme) + :type '(choice (const nil) string)) (defcustom scheme-program-arguments nil "Arguments passed to the Scheme program by the `run-scheme' command." - :type '(choice (const nil) string) - :group 'xscheme) + :type '(choice (const nil) string)) (defcustom xscheme-allow-pipelined-evaluation t "If non-nil, an expression may be transmitted while another is evaluating. Otherwise, attempting to evaluate an expression before the previous expression has finished evaluating will signal an error." - :type 'boolean - :group 'xscheme) + :type 'boolean) (defcustom xscheme-startup-message "This is the Scheme process buffer. @@ -128,19 +125,16 @@ Type \\[describe-mode] for more information. " "String to insert into Scheme process buffer first time it is started. Is processed with `substitute-command-keys' first." - :type 'string - :group 'xscheme) + :type 'string) (defcustom xscheme-signal-death-message nil "If non-nil, causes a message to be generated when the Scheme process dies." - :type 'boolean - :group 'xscheme) + :type 'boolean) (defcustom xscheme-start-hook nil "If non-nil, a procedure to call when the Scheme process is started. When called, the current buffer will be the Scheme process-buffer." :type 'hook - :group 'xscheme :version "20.3") (defun xscheme-evaluation-commands (keymap) From 06639a4ab27887804539f3dc9b805756e6020660 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 13 Feb 2021 07:22:44 +0100 Subject: [PATCH 160/297] Delete 20 year old comment in executable.el * lisp/progmodes/executable.el (executable-insert): Delete 20 year old comment. --- lisp/progmodes/executable.el | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index b1cd3303c5b..85e9b4bb882 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -54,20 +54,14 @@ "Base functionality for executable interpreter scripts." :group 'processes) -;; This used to default to `other', but that doesn't seem to have any -;; significance. fx 2000-02-11. -(defcustom executable-insert t ; 'other +(defcustom executable-insert t "Non-nil means offer to add a magic number to a file. This takes effect when you switch to certain major modes, including Shell-script mode (`sh-mode'). When you type \\[executable-set-magic], it always offers to add or update the magic number." -;;; :type '(choice (const :tag "off" nil) -;;; (const :tag "on" t) -;;; symbol) :type 'boolean) - (defcustom executable-query 'function "If non-nil, ask user before changing an existing magic number. When this is `function', only ask when called non-interactively." From aefdde96367ba38dbff8fa1761f44d5534fccaba Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 13 Feb 2021 12:46:34 +0100 Subject: [PATCH 161/297] add-minor-mode doc string clarification * lisp/subr.el (add-minor-mode): Clarify that this function isn't only about XEmacs compat stuff. --- lisp/subr.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/subr.el b/lisp/subr.el index 70ee281fe6e..d215bd29a91 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2318,7 +2318,8 @@ tho trying to avoid AVOIDED-MODES." (defun add-minor-mode (toggle name &optional keymap after toggle-fun) "Register a new minor mode. -This is an XEmacs-compatibility function. Use `define-minor-mode' instead. +This function shouldn't be used directly -- use `define-minor-mode' +instead (which will then call this function). TOGGLE is a symbol that is the name of a buffer-local variable that is toggled on or off to say whether the minor mode is active or not. From 1a6c7c10951ce6dadfdab36ad6ff6f679526828f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Feb 2021 14:57:25 +0200 Subject: [PATCH 162/297] Fix vertical cursor motion among many images * src/xdisp.c (move_it_in_display_line_to): Consider it MOVE_POS_MATCH_OR_ZV if we are just after an image, stretch, or display string, and the position matches exactly. This is needed when one image follows another at TO_CHARPOS. (Bug#46464) --- src/xdisp.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index fb8eaf4b967..125d3ed7f0f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9227,10 +9227,10 @@ move_it_in_display_line_to (struct it *it, || prev_method == GET_FROM_STRING) /* Passed TO_CHARPOS from left to right. */ && ((prev_pos < to_charpos - && IT_CHARPOS (*it) > to_charpos) + && IT_CHARPOS (*it) >= to_charpos) /* Passed TO_CHARPOS from right to left. */ || (prev_pos > to_charpos - && IT_CHARPOS (*it) < to_charpos))))) + && IT_CHARPOS (*it) <= to_charpos))))) { if (it->line_wrap != WORD_WRAP || wrap_it.sp < 0) { From 856502d80d0a3ccfe8c80b65290fdb00e8813391 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 13 Feb 2021 12:47:59 +0000 Subject: [PATCH 163/297] Remove stale comments from gnus-msg.el * lisp/gnus/gnus-msg.el (gnus-group-mail, gnus-group-news) (gnus-summary-mail-other-window, gnus-summary-news-other-window): Remove stale comments about let-binding gnus-newsgroup-name, as they should have been addressed (bug#37871#38). --- lisp/gnus/gnus-msg.el | 8 -------- 1 file changed, 8 deletions(-) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 45e665be8c3..61b76381a0b 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -609,8 +609,6 @@ instead." If ARG, use the group under the point to find a posting style. If ARG is 1, prompt for a group name to find the posting style." (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -634,8 +632,6 @@ This function prepares a news even when using mail groups. This is useful for posting messages to mail groups without actually sending them over the network. The corresponding back end must have a `request-post' method." (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -677,8 +673,6 @@ Use the posting of the current group by default. If ARG, don't do that. If ARG is 1, prompt for group name to find the posting style." (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -702,8 +696,6 @@ This function prepares a news even when using mail groups. This is useful for posting messages to mail groups without actually sending them over the network. The corresponding back end must have a `request-post' method." (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) From 625de7e403abb24c2d6ae417622fa8c7d6f55530 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 13 Feb 2021 14:25:42 +0100 Subject: [PATCH 164/297] Allow any JSON value at the top level (Bug#42994). Newer standards like RFC 8259, which obsoletes the earlier RFC 4627, now allow any top-level value unconditionally, so Emacs should too. * src/json.c (Fjson_serialize, Fjson_insert): Pass JSON_ENCODE_ANY to allow serialization of any JSON value. Call 'lisp_to_json' instead of 'lisp_to_json_toplevel'. Remove obsolete comments (neither JSON_DECODE_ANY nor JSON_ALLOW_NUL are allowed here). Reword documentation strings. (Fjson_parse_string, Fjson_parse_buffer): Pass JSON_DECODE_ANY to allow deserialization of any JSON value. Reword documentation strings. (lisp_to_json_nonscalar, lisp_to_json_nonscalar_1): Rename from "toplevel" to avoid confusion. (lisp_to_json): Adapt caller. * test/src/json-tests.el (json-serialize/roundtrip-scalars): New unit test. * doc/lispref/text.texi (Parsing JSON): Update documentation. --- doc/lispref/text.texi | 7 ++-- src/json.c | 74 +++++++++++++++++++++--------------------- test/src/json-tests.el | 28 ++++++++++++++++ 3 files changed, 68 insertions(+), 41 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index b3673465240..e47e851b101 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5288,10 +5288,9 @@ object parsed. Signaled when encountering invalid JSON syntax. @end table - Only top-level values (arrays and objects) can be serialized to -JSON@. The subobjects within these top-level values can be of any -type. Likewise, the parsing functions will only return vectors, -hashtables, alists, and plists. + Top-level values and the subobjects within these top-level values +can be serialized to JSON@. Likewise, the parsing functions will +return any of the possible types described above. @defun json-serialize object &rest args This function returns a new Lisp string which contains the JSON diff --git a/src/json.c b/src/json.c index 2901a20811a..e0e49ae308b 100644 --- a/src/json.c +++ b/src/json.c @@ -329,11 +329,11 @@ struct json_configuration { static json_t *lisp_to_json (Lisp_Object, struct json_configuration *conf); -/* Convert a Lisp object to a toplevel JSON object (array or object). */ +/* Convert a Lisp object to a nonscalar JSON object (array or object). */ static json_t * -lisp_to_json_toplevel_1 (Lisp_Object lisp, - struct json_configuration *conf) +lisp_to_json_nonscalar_1 (Lisp_Object lisp, + struct json_configuration *conf) { json_t *json; ptrdiff_t count; @@ -448,16 +448,17 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, return json; } -/* Convert LISP to a toplevel JSON object (array or object). Signal +/* Convert LISP to a nonscalar JSON object (array or object). Signal an error of type `wrong-type-argument' if LISP is not a vector, hashtable, alist, or plist. */ static json_t * -lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf) +lisp_to_json_nonscalar (Lisp_Object lisp, + struct json_configuration *conf) { if (++lisp_eval_depth > max_lisp_eval_depth) xsignal0 (Qjson_object_too_deep); - json_t *json = lisp_to_json_toplevel_1 (lisp, conf); + json_t *json = lisp_to_json_nonscalar_1 (lisp, conf); --lisp_eval_depth; return json; } @@ -499,7 +500,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf) } /* LISP now must be a vector, hashtable, alist, or plist. */ - return lisp_to_json_toplevel (lisp, conf); + return lisp_to_json_nonscalar (lisp, conf); } static void @@ -557,15 +558,15 @@ DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, NULL, doc: /* Return the JSON representation of OBJECT as a string. -OBJECT must be a vector, hashtable, alist, or plist and its elements -can recursively contain the Lisp equivalents to the JSON null and -false values, t, numbers, strings, or other vectors hashtables, alists -or plists. t will be converted to the JSON true value. Vectors will -be converted to JSON arrays, whereas hashtables, alists and plists are -converted to JSON objects. Hashtable keys must be strings without -embedded null characters and must be unique within each object. Alist -and plist keys must be symbols; if a key is duplicate, the first -instance is used. +OBJECT must be t, a number, string, vector, hashtable, alist, plist, +or the Lisp equivalents to the JSON null and false values, and its +elements must recursively consist of the same kinds of values. t will +be converted to the JSON true value. Vectors will be converted to +JSON arrays, whereas hashtables, alists and plists are converted to +JSON objects. Hashtable keys must be strings without embedded null +characters and must be unique within each object. Alist and plist +keys must be symbols; if a key is duplicate, the first instance is +used. The Lisp equivalents to the JSON null and false values are configurable in the arguments ARGS, a list of keyword/argument pairs: @@ -603,12 +604,10 @@ usage: (json-serialize OBJECT &rest ARGS) */) {json_object_hashtable, json_array_array, QCnull, QCfalse}; json_parse_args (nargs - 1, args + 1, &conf, false); - json_t *json = lisp_to_json_toplevel (args[0], &conf); + json_t *json = lisp_to_json (args[0], &conf); record_unwind_protect_ptr (json_release_object, json); - /* If desired, we might want to add the following flags: - JSON_DECODE_ANY, JSON_ALLOW_NUL. */ - char *string = json_dumps (json, JSON_COMPACT); + char *string = json_dumps (json, JSON_COMPACT | JSON_ENCODE_ANY); if (string == NULL) json_out_of_memory (); record_unwind_protect_ptr (json_free, string); @@ -723,12 +722,10 @@ usage: (json-insert OBJECT &rest ARGS) */) move_gap_both (PT, PT_BYTE); struct json_insert_data data; data.inserted_bytes = 0; - /* If desired, we might want to add the following flags: - JSON_DECODE_ANY, JSON_ALLOW_NUL. */ - int status - /* Could have used json_dumpb, but that became available only in - Jansson 2.10, whereas we want to support 2.7 and upward. */ - = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT); + /* Could have used json_dumpb, but that became available only in + Jansson 2.10, whereas we want to support 2.7 and upward. */ + int status = json_dump_callback (json, json_insert_callback, &data, + JSON_COMPACT | JSON_ENCODE_ANY); if (status == -1) { if (CONSP (data.error)) @@ -930,14 +927,14 @@ json_to_lisp (json_t *json, struct json_configuration *conf) DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, NULL, - doc: /* Parse the JSON STRING into a Lisp object. -This is essentially the reverse operation of `json-serialize', which -see. The returned object will be a vector, list, hashtable, alist, or -plist. Its elements will be the JSON null value, the JSON false -value, t, numbers, strings, or further vectors, hashtables, alists, or -plists. If there are duplicate keys in an object, all but the last -one are ignored. If STRING doesn't contain a valid JSON object, this -function signals an error of type `json-parse-error'. + doc: /* Parse the JSON STRING into a Lisp object. This is +essentially the reverse operation of `json-serialize', which see. The +returned object will be the JSON null value, the JSON false value, t, +a number, a string, a vector, a list, a hashtable, an alist, or a +plist. Its elements will be further objects of these types. If there +are duplicate keys in an object, all but the last one are ignored. If +STRING doesn't contain a valid JSON object, this function signals an +error of type `json-parse-error'. The arguments ARGS are a list of keyword/argument pairs: @@ -982,7 +979,8 @@ usage: (json-parse-string STRING &rest ARGS) */) json_parse_args (nargs - 1, args + 1, &conf, true); json_error_t error; - json_t *object = json_loads (SSDATA (encoded), 0, &error); + json_t *object + = json_loads (SSDATA (encoded), JSON_DECODE_ANY, &error); if (object == NULL) json_parse_error (&error); @@ -1078,8 +1076,10 @@ usage: (json-parse-buffer &rest args) */) ptrdiff_t point = PT_BYTE; struct json_read_buffer_data data = {.point = point}; json_error_t error; - json_t *object = json_load_callback (json_read_buffer_callback, &data, - JSON_DISABLE_EOF_CHECK, &error); + json_t *object + = json_load_callback (json_read_buffer_callback, &data, + JSON_DECODE_ANY | JSON_DISABLE_EOF_CHECK, + &error); if (object == NULL) json_parse_error (&error); diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 4be11b8c81a..908945fcb08 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -51,6 +51,34 @@ (should (equal (json-parse-buffer) lisp)) (should (eobp))))) +(ert-deftest json-serialize/roundtrip-scalars () + "Check that Bug#42994 is fixed." + (skip-unless (fboundp 'json-serialize)) + (dolist (case '((:null "null") + (:false "false") + (t "true") + (0 "0") + (123 "123") + (-456 "-456") + (3.75 "3.75") + ;; The noncharacter U+FFFF should be passed through, + ;; cf. https://www.unicode.org/faq/private_use.html#noncharacters. + ("abc\uFFFFαβγ𝔸𝐁𝖢\"\\" + "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\""))) + (cl-destructuring-bind (lisp json) case + (ert-info ((format "%S ↔ %S" lisp json)) + (should (equal (json-serialize lisp) json)) + (with-temp-buffer + (json-insert lisp) + (should (equal (buffer-string) json)) + (should (eobp))) + (should (equal (json-parse-string json) lisp)) + (with-temp-buffer + (insert json) + (goto-char 1) + (should (equal (json-parse-buffer) lisp)) + (should (eobp))))))) + (ert-deftest json-serialize/object () (skip-unless (fboundp 'json-serialize)) (let ((table (make-hash-table :test #'equal))) From 1680a1c0945cb0aa7e0e16867a9dacb8316cbf33 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 13 Feb 2021 14:35:30 +0100 Subject: [PATCH 165/297] Pass 'struct json_configuration' as const where possible. The JSON serialization and parsing functions don't need to modify these structures. * src/json.c (lisp_to_json_nonscalar_1, lisp_to_json_nonscalar) (lisp_to_json, json_to_lisp): Mark configuration object parameter as const. --- src/json.c | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/json.c b/src/json.c index e0e49ae308b..3562e175cfa 100644 --- a/src/json.c +++ b/src/json.c @@ -327,13 +327,14 @@ struct json_configuration { Lisp_Object false_object; }; -static json_t *lisp_to_json (Lisp_Object, struct json_configuration *conf); +static json_t *lisp_to_json (Lisp_Object, + const struct json_configuration *conf); /* Convert a Lisp object to a nonscalar JSON object (array or object). */ static json_t * lisp_to_json_nonscalar_1 (Lisp_Object lisp, - struct json_configuration *conf) + const struct json_configuration *conf) { json_t *json; ptrdiff_t count; @@ -454,7 +455,7 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, static json_t * lisp_to_json_nonscalar (Lisp_Object lisp, - struct json_configuration *conf) + const struct json_configuration *conf) { if (++lisp_eval_depth > max_lisp_eval_depth) xsignal0 (Qjson_object_too_deep); @@ -468,7 +469,7 @@ lisp_to_json_nonscalar (Lisp_Object lisp, JSON object. */ static json_t * -lisp_to_json (Lisp_Object lisp, struct json_configuration *conf) +lisp_to_json (Lisp_Object lisp, const struct json_configuration *conf) { if (EQ (lisp, conf->null_object)) return json_check (json_null ()); @@ -788,7 +789,7 @@ usage: (json-insert OBJECT &rest ARGS) */) /* Convert a JSON object to a Lisp object. */ static Lisp_Object ARG_NONNULL ((1)) -json_to_lisp (json_t *json, struct json_configuration *conf) +json_to_lisp (json_t *json, const struct json_configuration *conf) { switch (json_typeof (json)) { From c535fe647c02ccde424340dc8ceae75922443ca5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Feb 2021 16:10:53 +0200 Subject: [PATCH 166/297] ; * src/json.c (Fjson_parse_string): Fix the doc string. --- src/json.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/json.c b/src/json.c index 3562e175cfa..3f1d27ad7fb 100644 --- a/src/json.c +++ b/src/json.c @@ -928,14 +928,14 @@ json_to_lisp (json_t *json, const struct json_configuration *conf) DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, NULL, - doc: /* Parse the JSON STRING into a Lisp object. This is -essentially the reverse operation of `json-serialize', which see. The -returned object will be the JSON null value, the JSON false value, t, -a number, a string, a vector, a list, a hashtable, an alist, or a -plist. Its elements will be further objects of these types. If there -are duplicate keys in an object, all but the last one are ignored. If -STRING doesn't contain a valid JSON object, this function signals an -error of type `json-parse-error'. + doc: /* Parse the JSON STRING into a Lisp object. +This is essentially the reverse operation of `json-serialize', which +see. The returned object will be the JSON null value, the JSON false +value, t, a number, a string, a vector, a list, a hashtable, an alist, +or a plist. Its elements will be further objects of these types. If +there are duplicate keys in an object, all but the last one are +ignored. If STRING doesn't contain a valid JSON object, this function +signals an error of type `json-parse-error'. The arguments ARGS are a list of keyword/argument pairs: From 56c42bd28d9be400e37e122b7abebcd980ea0e8b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Feb 2021 17:27:02 +0200 Subject: [PATCH 167/297] Fix I-search at EOB when long lines are truncated * src/xdisp.c (move_it_to): Fix logic when TO_CHARPOS is at the end of an hscrolled line which ends at EOB. (Bug#46316) --- src/xdisp.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 125d3ed7f0f..a1956824214 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10049,7 +10049,9 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos it->continuation_lines_width = 0; reseat_at_next_visible_line_start (it, false); if ((op & MOVE_TO_POS) != 0 - && IT_CHARPOS (*it) > to_charpos) + && (IT_CHARPOS (*it) > to_charpos + || (IT_CHARPOS (*it) == to_charpos + && to_charpos == ZV))) { reached = 9; goto out; From f65402f851c91523ca44450c609bee07d37b9036 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 10:41:45 -0500 Subject: [PATCH 168/297] (backtrace-goto-source-functions): Make it a normal abnormal hook * lisp/emacs-lisp/backtrace.el (backtrace-goto-source-functions): Don't mark it as buffer-local any more. (backtrace-goto-source): Use `run-hook-with-args-until-success`. * lisp/emacs-lisp/edebug.el (edebug-pop-to-backtrace): Clarify that the hook is only intended to be modified buffer-locally. --- lisp/emacs-lisp/backtrace.el | 8 +++----- lisp/emacs-lisp/edebug.el | 3 ++- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 3e1c3292650..ea70baa9532 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -190,7 +190,7 @@ This is commonly used to recompute `backtrace-frames'.") (defvar-local backtrace-print-function #'cl-prin1 "Function used to print values in the current Backtrace buffer.") -(defvar-local backtrace-goto-source-functions nil +(defvar backtrace-goto-source-functions nil "Abnormal hook used to jump to the source code for the current frame. Each hook function is called with no argument, and should return non-nil if it is able to switch to the buffer containing the @@ -638,10 +638,8 @@ content of the sexp." (source-available (plist-get (backtrace-frame-flags frame) :source-available))) (unless (and source-available - (catch 'done - (dolist (func backtrace-goto-source-functions) - (when (funcall func) - (throw 'done t))))) + (run-hook-with-args-until-success + 'backtrace-goto-source-functions)) (user-error "Source code location not known")))) (defun backtrace-help-follow-symbol (&optional pos) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 394f47090ca..cbf2d171a96 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4247,7 +4247,8 @@ This should be a list of `edebug---frame' objects.") (pop-to-buffer edebug-backtrace-buffer) (unless (derived-mode-p 'backtrace-mode) (backtrace-mode) - (add-hook 'backtrace-goto-source-functions #'edebug--backtrace-goto-source)) + (add-hook 'backtrace-goto-source-functions + #'edebug--backtrace-goto-source nil t)) (setq edebug-instrumented-backtrace-frames (backtrace-get-frames 'edebug-debugger :constructor #'edebug--make-frame) From 6b0de9f8300022d41f3acd63ef6d9a913e983215 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Fri, 12 Feb 2021 19:29:54 +0100 Subject: [PATCH 169/297] Small correction to `isearch-lazy-highlight-buffer-update' The value of point is now read after a potential change of buffer. * lisp/isearch.el (isearch-lazy-highlight-buffer-update): Move call to `point' after `select-window'. Copyright-paperwork-exempt: yes --- lisp/isearch.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/isearch.el b/lisp/isearch.el index b58ca8a6f70..c571ea94670 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -4127,13 +4127,13 @@ Attempt to do the search exactly the way the pending Isearch would." "Update highlighting of other matches in the full buffer." (let ((max lazy-highlight-buffer-max-at-a-time) (looping t) - nomore window-start window-end - (opoint (point))) + nomore opoint window-start window-end) (with-local-quit (save-selected-window (if (and (window-live-p isearch-lazy-highlight-window) (not (memq (selected-window) isearch-lazy-highlight-window-group))) (select-window isearch-lazy-highlight-window)) + (setq opoint (point)) (setq window-start (window-group-start)) (setq window-end (window-group-end)) (save-excursion From e81cf63be15f907fbe9de6b6c9eb1a021d4e2fe2 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 13 Feb 2021 19:35:26 +0100 Subject: [PATCH 170/297] * etc/NEWS: Document new JSON behavior. --- etc/NEWS | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 464b955ee74..aead8c6f781 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2557,6 +2557,12 @@ 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. + * Changes in Emacs 28.1 on Non-Free Operating Systems From 2007afd21b5f6c72a7a9c15fd7c4785331f2700f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 16:21:53 -0500 Subject: [PATCH 171/297] * lisp/emacs-lisp/edebug.el (edebug--handle-&-spec-op <&name>): New method (edebug--concat-name): New function. (edebug-match-name, edebug-match-cl-generic-method-qualifier) (edebug-match-cl-generic-method-args): Delete functions. * doc/lispref/edebug.texi (Specification List): Document it. * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Use `&name`. (cl-generic--method-qualifier-p): New predicate. (cl-defmethod): Use it and `&name`. * lisp/emacs-lisp/cl-macs.el (cl-defun, cl-iter-defun, cl-flet): * lisp/emacs-lisp/eieio-compat.el (defmethod): * lisp/emacs-lisp/gv.el (gv-define-setter): * lisp/emacs-lisp/ert.el (ert-deftest): Use `&name`. * lisp/erc/erc-backend.el (define-erc-response-handler): Use `declare` and `&name`. --- doc/lispref/edebug.texi | 28 ++++------ etc/NEWS | 9 ++-- lisp/emacs-lisp/cl-generic.el | 36 ++++++++----- lisp/emacs-lisp/cl-macs.el | 9 ++-- lisp/emacs-lisp/edebug.el | 92 ++++++++++++++++++++------------- lisp/emacs-lisp/eieio-compat.el | 2 +- lisp/emacs-lisp/ert.el | 4 +- lisp/emacs-lisp/gv.el | 3 +- lisp/erc/erc-backend.el | 12 ++--- 9 files changed, 111 insertions(+), 84 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 99d55c7ab95..2412e844b70 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1444,29 +1444,23 @@ Here is a list of additional specifications that may appear only after @code{&define}. See the @code{defun} example. @table @code +@item &name +Extracts the name of the current defining form from the code. +It takes the form @code{&name [@var{prestring}] @var{spec} +[@var{poststring}] @var{fun} @var{args...}} and means that Edebug will +match @var{spec} against the code and then call @var{fun} with the +concatenation of the current name, @var{args...}, @var{prestring}, +the code that matched @code{spec}, and @var{poststring}. If @var{fun} +is absent, it defaults to a function that concatenates the arguments +(with an @code{@} between the previous name and the new). + @item name The argument, a symbol, is the name of the defining form. +Shorthand for @code{[&name symbolp]}. A defining form is not required to have a name field; and it may have multiple name fields. -@item :name -This construct does not actually match an argument. The element -following @code{:name} should be a symbol; it is used as an additional -name component for the definition. You can use this to add a unique, -static component to the name of the definition. It may be used more -than once. - -@item :unique -This construct is like @code{:name}, but generates unique names. It -does not match an argument. The element following @code{:unique} -should be a string; it is used as the prefix for an additional name -component for the definition. You can use this to add a unique, -dynamic component to the name of the definition. This is useful for -macros that can define the same symbol multiple times in different -scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may -be used more than once. - @item arg The argument, a symbol, is the name of an argument of the defining form. However, lambda-list keywords (symbols starting with @samp{&}) diff --git a/etc/NEWS b/etc/NEWS index aead8c6f781..de26c0172b1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -936,7 +936,11 @@ To customize obsolete user options, use 'customize-option' or ** Edebug --- -*** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. +*** Obsoletions +**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. + ++++ +**** The Edebug spec operator ':name NAME' is obsolete. +++ *** New function 'def-edebug-elem-spec' to define Edebug spec elements. @@ -954,8 +958,7 @@ declared obsolete. **** '&error MSG' unconditionally aborts the current edebug instrumentation. +++ -**** ':unique STRING' appends STRING to the Edebug name of the current -definition to (hopefully) make it more unique. +**** '&name SPEC FUN' extracts the current name from the code matching SPEC. ** ElDoc diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 8e36dbe4a36..229608395eb 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -206,22 +206,29 @@ DEFAULT-BODY, if present, is used as the body of a default method. \(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" (declare (indent 2) (doc-string 3) (debug - (&define [&or name ("setf" name :name setf)] listp - lambda-doc + (&define [&name sexp] ;Allow (setf ...) additionally to symbols. + listp lambda-doc [&rest [&or ("declare" &rest sexp) (":argument-precedence-order" &rest sexp) (&define ":method" - ;; FIXME: The `:unique' + ;; FIXME: The `gensym' ;; construct works around ;; Bug#42672. We'd rather want ;; names like those generated by ;; `cl-defmethod', but that ;; requires larger changes to ;; Edebug. - :unique "cl-generic-:method@" - [&rest cl-generic-method-qualifier] - cl-generic-method-args lambda-doc + [&name "cl-generic-:method@" []] + [&name [] gensym] ;Make it unique! + [&name + [[&rest cl-generic--method-qualifier-p] + ;; FIXME: We don't actually want the + ;; argument's names to be considered + ;; part of the name of the defined + ;; function. + listp]] ;Formal args + lambda-doc def-body)]] def-body))) (let* ((doc (if (stringp (car-safe options-and-methods)) @@ -398,6 +405,9 @@ the specializer used will be the one returned by BODY." (let ((combined-doc (buffer-string))) (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) +(defun cl-generic--method-qualifier-p (x) + (not (listp x))) + ;;;###autoload (defmacro cl-defmethod (name args &rest body) "Define a new method for generic function NAME. @@ -440,15 +450,17 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (declare (doc-string 3) (indent defun) (debug (&define ; this means we are defining something - [&or name ("setf" name :name setf)] - ;; ^^ This is the methods symbol - [ &rest cl-generic-method-qualifier ] - ;; Multiple qualifiers are allowed. - cl-generic-method-args ; arguments + [&name [sexp ;Allow (setf ...) additionally to symbols. + ;; Multiple qualifiers are allowed. + [&rest cl-generic--method-qualifier-p] + ;; FIXME: We don't actually want the argument's names + ;; to be considered part of the name of the + ;; defined function. + listp]] ; arguments lambda-doc ; documentation string def-body))) ; part to be debugged (let ((qualifiers nil)) - (while (not (listp args)) + (while (cl-generic--method-qualifier-p args) (push args qualifiers) (setq args (pop body))) (when (eq 'setf (car-safe name)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 5967e0d084f..e2faf6df534 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -358,7 +358,7 @@ more details. \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug ;; Same as defun but use cl-lambda-list. - (&define [&or name ("setf" :name setf name)] + (&define [&name sexp] ;Allow (setf ...) additionally to symbols. cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] @@ -376,7 +376,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug ;; Same as iter-defun but use cl-lambda-list. - (&define [&or name ("setf" :name setf name)] + (&define [&name sexp] ;Allow (setf ...) additionally to symbols. cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] @@ -2016,8 +2016,9 @@ info node `(cl) Function Bindings' for details. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) - (debug ((&rest [&or (&define name :unique "cl-flet@" form) - (&define name :unique "cl-flet@" + (debug ((&rest [&or (symbolp form) + (&define [&name symbolp "@cl-flet@"] + [&name [] gensym] ;Make it unique! cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index cbf2d171a96..867161e0280 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1748,16 +1748,12 @@ contains a circular object." (dolist (pair '((form . edebug-match-form) (sexp . edebug-match-sexp) (body . edebug-match-body) - (name . edebug-match-name) (arg . edebug-match-arg) (def-body . edebug-match-def-body) (def-form . edebug-match-def-form) ;; Less frequently used: ;; (function . edebug-match-function) (lambda-expr . edebug-match-lambda-expr) - (cl-generic-method-qualifier - . edebug-match-cl-generic-method-qualifier) - (cl-generic-method-args . edebug-match-cl-generic-method-args) (cl-macrolet-expr . edebug-match-cl-macrolet-expr) (cl-macrolet-name . edebug-match-cl-macrolet-name) (cl-macrolet-body . edebug-match-cl-macrolet-body) @@ -2056,19 +2052,61 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." ))) -(defun edebug-match-name (cursor) - ;; Set the edebug-def-name bound in edebug-defining-form. - (let ((name (edebug-top-element-required cursor "Expected name"))) - ;; Maybe strings and numbers could be used. - (if (not (symbolp name)) - (edebug-no-match cursor "Symbol expected for name of definition")) - (setq edebug-def-name - (if edebug-def-name - ;; Construct a new name by appending to previous name. - (intern (format "%s@%s" edebug-def-name name)) - name)) - (edebug-move-cursor cursor) - (list name))) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs) + "Compute the name for `&name SPEC FUN` spec operator. + +The full syntax of that operator is: + &name [PRESTRING] SPEC [POSTSTRING] FUN ARGS... + +Extracts the head of the data by matching it against SPEC, +and then get the new name to use by calling + (FUN ARGS... OLDNAME [PRESTRING] HEAD [POSTSTRING]) +FUN should return either a string or a symbol. +FUN can be missing in which case it defaults to concatenating +the new name to the end of the old with an \"@\" char between the two. +PRESTRING and POSTSTRING are optional strings that get prepended +or appended to the actual name." + (pcase-let* + ((`(,spec ,fun . ,args) specs) + (prestrings (when (stringp spec) + (prog1 (list spec) (setq spec fun fun (pop args))))) + (poststrings (when (stringp fun) + (prog1 (list fun) (setq fun (pop args))))) + (exps (edebug-cursor-expressions cursor)) + (instrumented (edebug-match-one-spec cursor spec)) + (consumed (- (length exps) + (length (edebug-cursor-expressions cursor)))) + (newname (apply (or fun #'edebug--concat-name) + `(,@args ,edebug-def-name + ,@prestrings + ,@(seq-subseq exps 0 consumed) + ,@poststrings)))) + (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps))) + (setq edebug-def-name (if (stringp newname) (intern newname) newname)) + instrumented)) + +(defun edebug--concat-name (oldname &rest newnames) + (let ((newname (if (null (cdr newnames)) + (car newnames) + ;; Put spaces between each name, but not for the + ;; leading and trailing strings, if any. + (let (beg mid end) + (dolist (name newnames) + (if (stringp name) + (push name (if mid end beg)) + (when end (setq mid (nconc end mid) end nil)) + (push name mid))) + (apply #'concat `(,@(nreverse beg) + ,(mapconcat (lambda (x) (format "%s" x)) + (nreverse mid) " ") + ,@(nreverse end))))))) + (if (null oldname) + (if (or (stringp newname) (symbolp newname)) + newname + (format "%s" newname)) + (format "%s@%s" edebug-def-name newname)))) + +(def-edebug-elem-spec 'name '(&name symbolp)) (cl-defgeneric edebug--handle-:-spec-op (op cursor spec) "Handle :foo spec operators. @@ -2094,26 +2132,6 @@ SPEC is the symbol name prefix for `gensym'." suffix))) nil) -(defun edebug-match-cl-generic-method-qualifier (cursor) - "Match a QUALIFIER for `cl-defmethod' at CURSOR." - (let ((args (edebug-top-element-required cursor "Expected qualifier"))) - ;; Like in CLOS spec, we support any non-list values. - (unless (atom args) (edebug-no-match cursor "Atom expected")) - ;; Append the arguments to `edebug-def-name' (Bug#42671). - (setq edebug-def-name (intern (format "%s %s" edebug-def-name args))) - (edebug-move-cursor cursor) - (list args))) - -(defun edebug-match-cl-generic-method-args (cursor) - (let ((args (edebug-top-element-required cursor "Expected arguments"))) - (if (not (consp args)) - (edebug-no-match cursor "List expected")) - ;; Append the arguments to edebug-def-name. - (setq edebug-def-name - (intern (format "%s %s" edebug-def-name args))) - (edebug-move-cursor cursor) - (list args))) - (defvar edebug--cl-macrolet-defs nil "List of symbols found within the bindings of enclosing `cl-macrolet' forms.") (defvar edebug--current-cl-macrolet-defs nil diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index db97d4ca4e8..6d84839c341 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -105,7 +105,7 @@ Summary: (declare (doc-string 3) (obsolete cl-defmethod "25.1") (debug (&define ; this means we are defining something - [&or name ("setf" name :name setf)] + [&name sexp] ;Allow (setf ...) additionally to symbols. ;; ^^ This is the methods symbol [ &optional symbolp ] ; this is key :before etc cl-generic-method-args ; arguments diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index fdbf95319ff..e08fa7ac7b3 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -196,8 +196,8 @@ it has to be wrapped in `(eval (quote ...))'. \(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \ [:tags \\='(TAG...)] BODY...)" - (declare (debug (&define :name test - name sexp [&optional stringp] + (declare (debug (&define [&name "test@" symbolp] + sexp [&optional stringp] [&rest keywordp sexp] def-body)) (doc-string 3) (indent 2)) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index edacdf7f0c8..3200b1c3494 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -229,7 +229,8 @@ The first arg in ARGLIST (the one that receives VAL) receives an expression which can do arbitrary things, whereas the other arguments are all guaranteed to be pure and copyable. Example use: (gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))" - (declare (indent 2) (debug (&define name :name gv-setter sexp def-body))) + (declare (indent 2) + (debug (&define [&name symbolp "@gv-setter"] sexp def-body))) `(gv-define-expander ,name (lambda (do &rest args) (declare-function diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 6f1193cbb2b..73c2b56b02e 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1079,14 +1079,12 @@ Finds hooks by looking in the `erc-server-responses' hash table." (erc-display-message parsed 'notice proc line))) -(put 'define-erc-response-handler 'edebug-form-spec - '(&define :name erc-response-handler - (name &rest name) - &optional sexp sexp def-body)) - (cl-defmacro define-erc-response-handler ((name &rest aliases) - &optional extra-fn-doc extra-var-doc - &rest fn-body) + &optional extra-fn-doc extra-var-doc + &rest fn-body) + (declare (debug (&define [&name "erc-response-handler@" + (symbolp &rest symbolp)] + &optional sexp sexp def-body))) "Define an ERC handler hook/function pair. NAME is the response name as sent by the server (see the IRC RFC for meanings). From 0474a0d7d4478e967c7bbee93ab3606f0b215e66 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Wed, 10 Feb 2021 22:12:16 +0000 Subject: [PATCH 172/297] Remove aliasing on SVG images under scaled NS frames * src/image.c (FRAME_SCALE_FACTOR): New #define for getting frame scale factor. (image_set_transform): (svg_load_image): Use FRAME_SCALE_FACTOR. * src/nsterm.m (ns_frame_scale_factor): Get the scale factor for an NS frame. --- src/image.c | 13 +++++++++++-- src/nsterm.h | 1 + src/nsterm.m | 11 +++++++++++ 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/src/image.c b/src/image.c index a124cf91ba0..8137dbea8d7 100644 --- a/src/image.c +++ b/src/image.c @@ -135,6 +135,12 @@ typedef struct ns_bitmap_record Bitmap_Record; # define COLOR_TABLE_SUPPORT 1 #endif +#if defined HAVE_NS +# define FRAME_SCALE_FACTOR(f) ns_frame_scale_factor (f) +#else +# define FRAME_SCALE_FACTOR(f) 1; +#endif + static void image_disable_image (struct frame *, struct image *); static void image_edge_detection (struct frame *, struct image *, Lisp_Object, Lisp_Object); @@ -2207,8 +2213,8 @@ image_set_transform (struct frame *f, struct image *img) /* SVGs are pre-scaled to the correct size. */ if (EQ (image_spec_value (img->spec, QCtype, NULL), Qsvg)) { - width = img->width; - height = img->height; + width = img->width / FRAME_SCALE_FACTOR (f); + height = img->height / FRAME_SCALE_FACTOR (f); } else #endif @@ -10008,6 +10014,9 @@ svg_load_image (struct frame *f, struct image *img, char *contents, compute_image_size (viewbox_width, viewbox_height, img->spec, &width, &height); + width *= FRAME_SCALE_FACTOR (f); + height *= FRAME_SCALE_FACTOR (f); + if (! check_image_size (f, width, height)) { image_size_error (); diff --git a/src/nsterm.h b/src/nsterm.h index eae1d0725ea..017c2394ef1 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1252,6 +1252,7 @@ struct input_event; extern void ns_init_events (struct input_event *); extern void ns_finish_events (void); +extern double ns_frame_scale_factor (struct frame *); #ifdef NS_IMPL_GNUSTEP extern char gnustep_base_version[]; /* version tracking */ diff --git a/src/nsterm.m b/src/nsterm.m index 1b2328628ee..ca240eb55f1 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -857,6 +857,17 @@ Free a pool and temporary objects it refers to (callable from C) } +double +ns_frame_scale_factor (struct frame *f) +{ +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > 1060 + return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; +#else + return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor]; +#endif +} + + /* ========================================================================== Focus (clipping) and screen update From 68bd6f3ea9c05637501139c46f1f4304482db95f Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sun, 31 Jan 2021 20:19:53 +0000 Subject: [PATCH 173/297] Fix flicker when resizing NS frame programmatically (bug#46155) ; Incidentally fixes bug#21326. * src/nsterm.m ([EmacsView viewWillDraw]): New function. ([EmacsView viewDidResize:]): We now have to mark the frame for display on resize. ([EmacsView initFrameFromEmacs:]): Retain frame contents on resize. ([EmacsView updateLayer]): Don't update the layer if the frame is still garbaged. --- src/nsterm.m | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/src/nsterm.m b/src/nsterm.m index ca240eb55f1..b0cf5952fd5 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -7350,6 +7350,8 @@ - (void)viewDidResize:(NSNotification *)notification [surface release]; surface = nil; + + [self setNeedsDisplay:YES]; } #endif @@ -7521,6 +7523,16 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f [self initWithFrame: r]; [self setAutoresizingMask: NSViewWidthSizable | NSViewHeightSizable]; +#ifdef NS_DRAW_TO_BUFFER + /* These settings mean AppKit will retain the contents of the frame + on resize. Unfortunately it also means the frame will not be + automatically marked for display, but we can do that ourselves in + viewDidResize. */ + [self setLayerContentsRedrawPolicy: + NSViewLayerContentsRedrawOnSetNeedsDisplay]; + [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft]; +#endif + FRAME_NS_VIEW (f) = self; emacsframe = f; #ifdef NS_IMPL_COCOA @@ -8463,6 +8475,34 @@ - (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect } +#ifdef NS_IMPL_COCOA +/* If the frame has been garbaged but the toolkit wants to draw, for + example when resizing the frame, we end up with a blank screen. + Sometimes this results in an unpleasant flicker, so try to + redisplay before drawing. */ +- (void)viewWillDraw +{ + if (FRAME_GARBAGED_P (emacsframe) + && !redisplaying_p) + { + /* If there is IO going on when redisplay is run here Emacs + crashes. I think it's because this code will always be run + within the run loop and for whatever reason processing input + is dangerous. This technique was stolen wholesale from + nsmenu.m and seems to work. */ + bool owfi = waiting_for_input; + waiting_for_input = 0; + block_input (); + + redisplay (); + + unblock_input (); + waiting_for_input = owfi; + } +} +#endif + + #ifdef NS_DRAW_TO_BUFFER - (BOOL)wantsUpdateLayer { @@ -8480,6 +8520,13 @@ - (void)updateLayer { NSTRACE ("[EmacsView updateLayer]"); + /* We run redisplay on frames that are garbaged, but marked for + display, before updateLayer is called so if the frame is still + garbaged that means the last redisplay must have refused to + update the frame. */ + if (FRAME_GARBAGED_P (emacsframe)) + return; + /* This can fail to update the screen if the same surface is provided twice in a row, even if its contents have changed. There's a private method, -[CALayer setContentsChanged], that we From 39a401ddae154b94e4c0e9c8ced1b27d9dc56daa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 17:50:31 -0500 Subject: [PATCH 174/297] * lisp/emacs-lisp/edebug.el (edebug-match-lambda-expr): Delete function (lambda-expr): Define with `def-edebug-elem-spec` instead. (edebug--handle-&-spec-op): Remove left over code. (interactive): Re-add mistakenly removed spec elem. * doc/lispref/edebug.texi (Specification List): Remove `function-form`. --- doc/lispref/edebug.texi | 10 +--------- etc/NEWS | 4 +++- lisp/emacs-lisp/edebug.el | 36 ++++++++---------------------------- 3 files changed, 12 insertions(+), 38 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 2412e844b70..46f5cb9026a 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1290,14 +1290,6 @@ Short for @code{&rest form}. See @code{&rest} below. If your macro wraps its body of code with @code{lambda} before it is evaluated, use @code{def-body} instead. See @code{def-body} below. -@item function-form -A function form: either a quoted function symbol, a quoted lambda -expression, or a form (that should evaluate to a function symbol or -lambda expression). This is useful when an argument that's a lambda -expression might be quoted with @code{quote} rather than -@code{function}, since it instruments the body of the lambda expression -either way. - @item lambda-expr A lambda expression with no quoting. @@ -1452,7 +1444,7 @@ match @var{spec} against the code and then call @var{fun} with the concatenation of the current name, @var{args...}, @var{prestring}, the code that matched @code{spec}, and @var{poststring}. If @var{fun} is absent, it defaults to a function that concatenates the arguments -(with an @code{@} between the previous name and the new). +(with an @code{@@} between the previous name and the new). @item name The argument, a symbol, is the name of the defining form. diff --git a/etc/NEWS b/etc/NEWS index de26c0172b1..d865aa7c746 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -940,7 +940,9 @@ To customize obsolete user options, use 'customize-option' or **** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. +++ -**** The Edebug spec operator ':name NAME' is obsolete. +**** The spec operator ':name NAME' is obsolete, use '&name' instead. ++++ +**** The spec element 'function-form' is obsolete, use 'form' instead. +++ *** New function 'def-edebug-elem-spec' to define Edebug spec elements. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 867161e0280..1cc95f7ac8c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1753,7 +1753,6 @@ contains a circular object." (def-form . edebug-match-def-form) ;; Less frequently used: ;; (function . edebug-match-function) - (lambda-expr . edebug-match-lambda-expr) (cl-macrolet-expr . edebug-match-cl-macrolet-expr) (cl-macrolet-name . edebug-match-cl-macrolet-name) (cl-macrolet-body . edebug-match-cl-macrolet-body) @@ -1873,7 +1872,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." (pcase-let* ((`(,spec ,fun . ,args) specs) (exps (edebug-cursor-expressions cursor)) - (instrumented-head (edebug-match-one-spec cursor (or spec 'sexp))) + (instrumented-head (edebug-match-one-spec cursor spec)) (consumed (- (length exps) (length (edebug-cursor-expressions cursor)))) (newspecs (apply fun (append args (seq-subseq exps 0 consumed))))) @@ -2026,32 +2025,6 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." offsets) specs)) -(defun edebug-match-lambda-expr (cursor) - ;; The expression must be a function. - ;; This will match any list form that begins with a symbol - ;; that has an edebug-form-spec beginning with &define. In - ;; practice, only lambda expressions should be used. - ;; I could add a &lambda specification to avoid confusion. - (let* ((sexp (edebug-top-element-required - cursor "Expected lambda expression")) - (offset (edebug-top-offset cursor)) - (head (and (consp sexp) (car sexp))) - (spec (and (symbolp head) (edebug-get-spec head))) - (edebug-inside-func nil)) - ;; Find out if this is a defining form from first symbol. - (if (and (consp spec) (eq '&define (car spec))) - (prog1 - (list - (edebug-defining-form - (edebug-new-cursor sexp offset) - (car offset);; before the sexp - (edebug-after-offset cursor) - (cons (symbol-name head) (cdr spec)))) - (edebug-move-cursor cursor)) - (edebug-no-match cursor "Expected lambda expression") - ))) - - (cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs) "Compute the name for `&name SPEC FUN` spec operator. @@ -2271,12 +2244,19 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." &optional ["&rest" arg] ))) +(def-edebug-elem-spec 'lambda-expr + '(("lambda" &define lambda-list lambda-doc + [&optional ("interactive" interactive)] + def-body))) + (def-edebug-elem-spec 'arglist '(lambda-list)) ;; deprecated - use lambda-list. (def-edebug-elem-spec 'lambda-doc '(&optional [&or stringp (&define ":documentation" def-form)])) +(def-edebug-elem-spec 'interactive '(&optional &or stringp def-form)) + ;; A function-form is for an argument that may be a function or a form. ;; This specially recognizes anonymous functions quoted with quote. (def-edebug-elem-spec 'function-form ;Deprecated, use `form'! From 2d9ff601ab5fc7187f0466f22c6c5e9451bce04f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 19:22:17 -0500 Subject: [PATCH 175/297] * lisp/emacs-lisp/edebug.el: Fix `called-interactively-p` And get rid of the old special-case handling of `interactive-p`, which is now redundant. (edebug--called-interactively-skip): Fix lexical-binding case, and adjust to some formerly missed call patterns. (edebug-def-interactive, edebug-interactive-p): Remove vars. (edebug-interactive-p-name, edebug-wrap-def-body) (edebug-make-enter-wrapper): Remove functions. (edebug-list-form): Don't special-case `interactive-p`. --- lisp/emacs-lisp/edebug.el | 70 +++++++-------------------------------- 1 file changed, 12 insertions(+), 58 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1cc95f7ac8c..76fb19023a0 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1235,54 +1235,11 @@ purpose by adding an entry to this alist, and setting (funcall edebug-after-instrumentation-function result)))) (defvar edebug-def-args) ; args of defining form. -(defvar edebug-def-interactive) ; is it an emacs interactive function? (defvar edebug-inside-func) ;; whether code is inside function context. ;; Currently def-form sets this to nil; def-body sets it to t. (defvar edebug--cl-macrolet-defs) ;; Fully defined below. -(defun edebug-interactive-p-name () - ;; Return a unique symbol for the variable used to store the - ;; status of interactive-p for this function. - (intern (format "edebug-%s-interactive-p" edebug-def-name))) - - -(defun edebug-wrap-def-body (forms) - "Wrap the FORMS of a definition body." - (if edebug-def-interactive - `(let ((,(edebug-interactive-p-name) - (called-interactively-p 'interactive))) - ,(edebug-make-enter-wrapper forms)) - (edebug-make-enter-wrapper forms))) - - -(defun edebug-make-enter-wrapper (forms) - ;; Generate the enter wrapper for some forms of a definition. - ;; This is not to be used for the body of other forms, e.g. `while', - ;; since it wraps the list of forms with a call to `edebug-enter'. - ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. - ;; Do this after parsing since that may find a name. - (when (string-match-p (rx bos "edebug-anon" (+ digit) eos) - (symbol-name edebug-old-def-name)) - ;; FIXME: Due to Bug#42701, we reset an anonymous name so that - ;; backtracking doesn't generate duplicate definitions. It would - ;; be better to not define wrappers in the case of a non-matching - ;; specification branch to begin with. - (setq edebug-old-def-name nil)) - (setq edebug-def-name - (or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) - `(edebug-enter - (quote ,edebug-def-name) - ,(if edebug-inside-func - `(list - ;; Doesn't work with more than one def-body!! - ;; But the list will just be reversed. - ,@(nreverse edebug-def-args)) - 'nil) - (function (lambda () ,@forms)) - )) - - (defvar edebug-form-begin-marker) ; the mark for def being instrumented (defvar edebug-offset-index) ; the next available offset index. @@ -1404,7 +1361,6 @@ contains a circular object." (edebug-old-def-name (edebug--form-data-name form-data-entry)) edebug-def-name edebug-def-args - edebug-def-interactive edebug-inside-func;; whether wrapped code executes inside a function. ) @@ -1610,11 +1566,6 @@ contains a circular object." ((symbolp head) (cond ((null head) nil) ; () is valid. - ((eq head 'interactive-p) - ;; Special case: replace (interactive-p) with variable - (setq edebug-def-interactive 'check-it) - (edebug-move-cursor cursor) - (edebug-interactive-p-name)) (t (cons head (edebug-list-form-args head (edebug-move-cursor cursor)))))) @@ -2170,7 +2121,7 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." ;; This happens to handle bug#20281, tho maybe a better fix would be to ;; improve the `defun' spec. (when forms - (list (edebug-wrap-def-body forms))))) + (list (edebug-make-enter-wrapper forms))))) ;;;; Edebug Form Specs @@ -2922,7 +2873,6 @@ See `edebug-behavior-alist' for implementations.") (defvar edebug-outside-match-data) ; match data outside of edebug (defvar edebug-backtrace-buffer) ; each recursive edit gets its own (defvar edebug-inside-windows) -(defvar edebug-interactive-p) (defvar edebug-mode-map) ; will be defined fully later. @@ -2938,7 +2888,6 @@ See `edebug-behavior-alist' for implementations.") ;;(edebug-number-of-recursions (1+ edebug-number-of-recursions)) (edebug-recursion-depth (recursion-depth)) edebug-entered ; bind locally to nil - (edebug-interactive-p nil) ; again non-interactive edebug-backtrace-buffer ; each recursive edit gets its own ;; The window configuration may be saved and restored ;; during a recursive-edit @@ -4588,13 +4537,18 @@ With prefix argument, make it a temporary breakpoint." (add-hook 'called-interactively-p-functions #'edebug--called-interactively-skip) (defun edebug--called-interactively-skip (i frame1 frame2) - (when (and (eq (car-safe (nth 1 frame1)) 'lambda) - (eq (nth 1 (nth 1 frame1)) '()) - (eq (nth 1 frame2) 'edebug-enter)) + (when (and (memq (car-safe (nth 1 frame1)) '(lambda closure)) + ;; Lambda value with no arguments. + (null (nth (if (eq (car-safe (nth 1 frame1)) 'lambda) 1 2) + (nth 1 frame1))) + (memq (nth 1 frame2) '(edebug-enter edebug-default-enter))) ;; `edebug-enter' calls itself on its first invocation. - (if (eq (nth 1 (backtrace-frame i 'called-interactively-p)) - 'edebug-enter) - 2 1))) + (let ((s 1)) + (while (memq (nth 1 (backtrace-frame i 'called-interactively-p)) + '(edebug-enter edebug-default-enter)) + (cl-incf s) + (cl-incf i)) + s))) ;; Finally, hook edebug into the rest of Emacs. ;; There are probably some other things that could go here. From 103039b06c2c9a917fc796d2a4afda8433e37473 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 19:24:33 -0500 Subject: [PATCH 176/297] * lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper): Reinstate. Removed by accident. --- lisp/emacs-lisp/edebug.el | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 76fb19023a0..8fadeba6c9a 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1240,6 +1240,33 @@ purpose by adding an entry to this alist, and setting (defvar edebug--cl-macrolet-defs) ;; Fully defined below. +(defun edebug-make-enter-wrapper (forms) + ;; Generate the enter wrapper for some forms of a definition. + ;; This is not to be used for the body of other forms, e.g. `while', + ;; since it wraps the list of forms with a call to `edebug-enter'. + ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. + ;; Do this after parsing since that may find a name. + (when (string-match-p (rx bos "edebug-anon" (+ digit) eos) + (symbol-name edebug-old-def-name)) + ;; FIXME: Due to Bug#42701, we reset an anonymous name so that + ;; backtracking doesn't generate duplicate definitions. It would + ;; be better to not define wrappers in the case of a non-matching + ;; specification branch to begin with. + (setq edebug-old-def-name nil)) + (setq edebug-def-name + (or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) + `(edebug-enter + (quote ,edebug-def-name) + ,(if edebug-inside-func + `(list + ;; Doesn't work with more than one def-body!! + ;; But the list will just be reversed. + ,@(nreverse edebug-def-args)) + 'nil) + (function (lambda () ,@forms)) + )) + + (defvar edebug-form-begin-marker) ; the mark for def being instrumented (defvar edebug-offset-index) ; the next available offset index. From 760910f4917ad8ff5e1cd1bf0bfec443b02f0e44 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 12:37:44 +0100 Subject: [PATCH 177/297] Add a new buffer-local variable `minor-modes' * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Keep `minor-modes' updated. * src/buffer.c (bset_minor_modes, Fmake_indirect_buffer) (reset_buffer, init_buffer_once): Initialise `minor-modes'. (syms_of_buffer): Add `minor-modes' as a new permanently-local variable. * src/buffer.h (struct buffer): Add minor_modes_. --- doc/lispref/modes.texi | 5 +++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/easy-mmode.el | 4 ++++ src/buffer.c | 13 +++++++++++++ src/buffer.h | 3 +++ 5 files changed, 30 insertions(+) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 3c64e97b3b9..3a4828c8fab 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1454,6 +1454,11 @@ used only with Diff mode. other minor modes in effect. It should be possible to activate and deactivate minor modes in any order. +@defvar minor-modes +This buffer-local variable lists the currently enabled minor modes in +the current buffer, and is a list if symbols. +@end defvar + @defvar minor-mode-list The value of this variable is a list of all minor mode commands. @end defvar diff --git a/etc/NEWS b/etc/NEWS index d865aa7c746..7e224b411f8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2266,6 +2266,11 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 ++++ +** New buffer-local variable 'minor-modes'. +This permanently buffer-local variable holds a list of currently +enabled minor modes in the current buffer (as a list of symbols). + ** The 'values' variable is now obsolete. --- diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 2916ae4adea..bfffbe4bf20 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -317,6 +317,10 @@ or call the function `%s'.")))) nil) (t t))) + ;; Keep `minor-modes' up to date. + (setq minor-modes (delq ',modefun minor-modes)) + (when ,getter + (push ',modefun minor-modes)) ,@body ;; The on/off hooks are here for backward compatibility only. (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) diff --git a/src/buffer.c b/src/buffer.c index 80c799e719b..487599dbbed 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -292,6 +292,11 @@ bset_major_mode (struct buffer *b, Lisp_Object val) b->major_mode_ = val; } static void +bset_minor_modes (struct buffer *b, Lisp_Object val) +{ + b->minor_modes_ = val; +} +static void bset_mark (struct buffer *b, Lisp_Object val) { b->mark_ = val; @@ -893,6 +898,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) bset_file_truename (b, Qnil); bset_display_count (b, make_fixnum (0)); bset_backed_up (b, Qnil); + bset_minor_modes (b, Qnil); bset_auto_save_file_name (b, Qnil); set_buffer_internal_1 (b); Fset (intern ("buffer-save-without-query"), Qnil); @@ -967,6 +973,7 @@ reset_buffer (register struct buffer *b) b->clip_changed = 0; b->prevent_redisplay_optimizations_p = 1; bset_backed_up (b, Qnil); + bset_minor_modes (b, Qnil); BUF_AUTOSAVE_MODIFF (b) = 0; b->auto_save_failure_time = 0; bset_auto_save_file_name (b, Qnil); @@ -5151,6 +5158,7 @@ init_buffer_once (void) bset_auto_save_file_name (&buffer_local_flags, make_fixnum (-1)); bset_read_only (&buffer_local_flags, make_fixnum (-1)); bset_major_mode (&buffer_local_flags, make_fixnum (-1)); + bset_minor_modes (&buffer_local_flags, make_fixnum (-1)); bset_mode_name (&buffer_local_flags, make_fixnum (-1)); bset_undo_list (&buffer_local_flags, make_fixnum (-1)); bset_mark_active (&buffer_local_flags, make_fixnum (-1)); @@ -5617,6 +5625,11 @@ The default value (normally `fundamental-mode') affects new buffers. A value of nil means to use the current buffer's major mode, provided it is not marked as "special". */); + DEFVAR_PER_BUFFER ("minor-modes", &BVAR (current_buffer, minor_modes), + Qnil, + doc: /* Minor modes currently active in the current buffer. +This is a list of symbols, or nil if there are no minor modes active. */); + DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name), Qnil, doc: /* Pretty name of current buffer's major mode. diff --git a/src/buffer.h b/src/buffer.h index 790291f1185..0668d16608b 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -338,6 +338,9 @@ struct buffer /* Symbol naming major mode (e.g., lisp-mode). */ Lisp_Object major_mode_; + /* Symbol listing all currently enabled minor modes. */ + Lisp_Object minor_modes_; + /* Pretty name of major mode (e.g., "Lisp"). */ Lisp_Object mode_name_; From 7f62faf20607394f9c6dfa0f1696cb68291f9fb7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 14 Feb 2021 12:54:36 +0100 Subject: [PATCH 178/297] Remove redundant :group args from textmodes/*.el * lisp/textmodes/enriched.el: * lisp/textmodes/ispell.el: * lisp/textmodes/makeinfo.el: * lisp/textmodes/paragraphs.el: * lisp/textmodes/picture.el: * lisp/textmodes/refbib.el: * lisp/textmodes/refer.el: * lisp/textmodes/remember.el: * lisp/textmodes/texinfo.el: * lisp/textmodes/tildify.el: * lisp/textmodes/two-column.el: Remove redundant :group args. --- lisp/textmodes/enriched.el | 15 ++---- lisp/textmodes/ispell.el | 94 ++++++++++++------------------------ lisp/textmodes/makeinfo.el | 6 +-- lisp/textmodes/paragraphs.el | 7 --- lisp/textmodes/picture.el | 24 +++------ lisp/textmodes/refbib.el | 21 +++----- lisp/textmodes/refer.el | 12 ++--- lisp/textmodes/remember.el | 53 +++++++------------- lisp/textmodes/texinfo.el | 25 +++------- lisp/textmodes/tildify.el | 9 ---- lisp/textmodes/two-column.el | 18 +++---- 11 files changed, 88 insertions(+), 196 deletions(-) diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index fe92d603065..c44b69cdb73 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -50,8 +50,7 @@ (defcustom enriched-verbose t "If non-nil, give status messages when reading and writing files." - :type 'boolean - :group 'enriched) + :type 'boolean) ;;; ;;; Set up faces & display table @@ -65,14 +64,12 @@ "Face used for text that must be shown in fixed width. Currently, Emacs can only display fixed-width fonts, but this may change. This face is used for text specifically marked as fixed-width, for example -in text/enriched files." - :group 'enriched) +in text/enriched files.") (defface excerpt '((t (:slant italic))) "Face used for text that is an excerpt from another document. -This is used in Enriched mode for text explicitly marked as an excerpt." - :group 'enriched) +This is used in Enriched mode for text explicitly marked as an excerpt.") (defconst enriched-display-table (or (copy-sequence standard-display-table) (make-display-table))) @@ -146,8 +143,7 @@ Any property that is neither on this list nor dealt with by If you set variables in this hook, you should arrange for them to be restored to their old values if you leave Enriched mode. One way to do this is to add them and their old values to `enriched-old-bindings'." - :type 'hook - :group 'enriched) + :type 'hook) (defcustom enriched-allow-eval-in-display-props nil "If non-nil allow to evaluate arbitrary forms in display properties. @@ -162,8 +158,7 @@ Note, however, that applying unsafe display properties could execute malicious Lisp code, if that code came from an external source." :risky t :type 'boolean - :version "26.1" - :group 'enriched) + :version "26.1") (defvar-local enriched-old-bindings nil "Store old variable values that we change when entering mode. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index ea46270508e..cee578fc4b8 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -131,8 +131,7 @@ (defcustom ispell-highlight-p 'block "Highlight spelling errors when non-nil. When set to `block', assumes a block cursor with TTY displays." - :type '(choice (const block) (const :tag "off" nil) (const :tag "on" t)) - :group 'ispell) + :type '(choice (const block) (const :tag "off" nil) (const :tag "on" t))) (defcustom ispell-lazy-highlight (boundp 'lazy-highlight-cleanup) "Controls the lazy-highlighting of spelling errors. @@ -141,7 +140,6 @@ error is highlighted lazily using isearch lazy highlighting (see `lazy-highlight-initial-delay' and `lazy-highlight-interval')." :type 'boolean :group 'lazy-highlight - :group 'ispell :version "22.1") (defcustom ispell-highlight-face (if ispell-lazy-highlight 'isearch 'highlight) @@ -149,16 +147,14 @@ error is highlighted lazily using isearch lazy highlighting (see This variable can be set by the user to whatever face they desire. It's most convenient if the cursor color and highlight color are slightly different." - :type 'face - :group 'ispell) + :type 'face) (defcustom ispell-check-comments t "Spelling of comments checked when non-nil. When set to `exclusive', ONLY comments are checked. (For code comments). Warning! Not checking comments, when a comment start is embedded in strings, may produce undesired results." - :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t)) - :group 'ispell) + :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t))) ;;;###autoload (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -166,8 +162,7 @@ may produce undesired results." (defcustom ispell-query-replace-choices nil "Corrections made throughout region when non-nil. Uses `query-replace' (\\[query-replace]) for corrections." - :type 'boolean - :group 'ispell) + :type 'boolean) (defcustom ispell-skip-tib nil "Does not spell check `tib' bibliography references when non-nil. @@ -177,8 +172,7 @@ Skips any text between strings matching regular expressions TeX users beware: Any text between [. and .] will be skipped -- even if that's your whole buffer -- unless you set `ispell-skip-tib' to nil. That includes the [.5mm] type of number..." - :type 'boolean - :group 'ispell) + :type 'boolean) (defvar ispell-tib-ref-beginning "[[<]\\." "Regexp matching the beginning of a Tib reference.") @@ -189,14 +183,12 @@ That includes the [.5mm] type of number..." (defcustom ispell-keep-choices-win t "If non-nil, keep the `*Choices*' window for the entire spelling session. This minimizes redisplay thrashing." - :type 'boolean - :group 'ispell) + :type 'boolean) (defcustom ispell-choices-win-default-height 2 "The default size of the `*Choices*' window, including the mode line. Must be greater than 1." - :type 'integer - :group 'ispell) + :type 'integer) (defcustom ispell-program-name (or (executable-find "aspell") @@ -211,8 +203,7 @@ Must be greater than 1." :set (lambda (symbol value) (set-default symbol value) (if (featurep 'ispell) - (ispell-set-spellchecker-params))) - :group 'ispell) + (ispell-set-spellchecker-params)))) (defcustom ispell-alternate-dictionary (cond ((file-readable-p "/usr/dict/web2") "/usr/dict/web2") @@ -224,14 +215,12 @@ Must be greater than 1." "/usr/share/lib/dict/words") ((file-readable-p "/sys/dict") "/sys/dict")) "Alternate plain word-list dictionary for spelling help." - :type '(choice file (const :tag "None" nil)) - :group 'ispell) + :type '(choice file (const :tag "None" nil))) (defcustom ispell-complete-word-dict nil "Plain word-list dictionary used for word completion if different from `ispell-alternate-dictionary'." - :type '(choice file (const :tag "None" nil)) - :group 'ispell) + :type '(choice file (const :tag "None" nil))) (defcustom ispell-message-dictionary-alist nil "List used by `ispell-message' to select a new dictionary. @@ -241,29 +230,25 @@ DICTIONARY if `ispell-local-dictionary' is not buffer-local. E.g. you may use the following value: ((\"^Newsgroups:[ \\t]*de\\\\.\" . \"deutsch8\") (\"^To:[^\\n,]+\\\\.de[ \\t\\n,>]\" . \"deutsch8\"))" - :type '(repeat (cons regexp string)) - :group 'ispell) + :type '(repeat (cons regexp string))) (defcustom ispell-message-fcc-skip 50000 "Query before saving Fcc message copy if attachment larger than this value. Always stores Fcc copy of message when nil." - :type '(choice integer (const :tag "off" nil)) - :group 'ispell) + :type '(choice integer (const :tag "off" nil))) (defcustom ispell-grep-command "grep" "Name of the grep command for search processes." - :type 'string - :group 'ispell) + :type 'string) (defcustom ispell-grep-options "-Ei" "String of options to use when running the program in `ispell-grep-command'. Should probably be \"-Ei\"." - :type 'string - :group 'ispell) + :type 'string) (defcustom ispell-look-command (cond ((file-exists-p "/bin/look") "/bin/look") @@ -272,36 +257,30 @@ Should probably be \"-Ei\"." (t "look")) "Name of the look command for search processes. This must be an absolute file name." - :type 'file - :group 'ispell) + :type 'file) (defcustom ispell-look-p (file-exists-p ispell-look-command) "Non-nil means use `look' rather than `grep'. Default is based on whether `look' seems to be available." - :type 'boolean - :group 'ispell) + :type 'boolean) (defcustom ispell-have-new-look nil "Non-nil means use the `-r' option (regexp) when running `look'." - :type 'boolean - :group 'ispell) + :type 'boolean) (defcustom ispell-look-options (if ispell-have-new-look "-dfr" "-df") "String of command options for `ispell-look-command'." - :type 'string - :group 'ispell) + :type 'string) (defcustom ispell-use-ptys-p nil "When non-nil, Emacs uses ptys to communicate with Ispell. When nil, Emacs uses pipes." - :type 'boolean - :group 'ispell) + :type 'boolean) (defcustom ispell-following-word nil "Non-nil means `ispell-word' checks the word around or after point. Otherwise `ispell-word' checks the preceding word." - :type 'boolean - :group 'ispell) + :type 'boolean) (defcustom ispell-help-in-bufferp nil "Non-nil means display interactive keymap help in a buffer. @@ -312,21 +291,18 @@ The following values are supported: for a couple of seconds. electric Pop up a new buffer and display a long help message there. User can browse and then exit the help mode." - :type '(choice (const electric) (const :tag "off" nil) (const :tag "on" t)) - :group 'ispell) + :type '(choice (const electric) (const :tag "off" nil) (const :tag "on" t))) (defcustom ispell-quietly nil "Non-nil means suppress messages in `ispell-word'." - :type 'boolean - :group 'ispell) + :type 'boolean) (defvaralias 'ispell-format-word 'ispell-format-word-function) (defcustom ispell-format-word-function (function upcase) "Formatting function for displaying word being spell checked. The function must take one string argument and return a string." - :type 'function - :group 'ispell) + :type 'function) ;; FIXME framepop.el last updated c 2003 (?), ;; use posframe. @@ -335,21 +311,18 @@ The function must take one string argument and return a string." You can set this variable to dynamically use framepop if you are in a window system by evaluating the following on startup to set this variable: (and (display-graphic-p) (require \\='framepop nil t))" - :type 'boolean - :group 'ispell) + :type 'boolean) ;;;###autoload (defcustom ispell-personal-dictionary nil "File name of your personal spelling dictionary, or nil. If nil, the default personal dictionary for your spelling checker is used." :type '(choice file - (const :tag "default" nil)) - :group 'ispell) + (const :tag "default" nil))) (defcustom ispell-silently-savep nil "When non-nil, save personal dictionary without asking for confirmation." - :type 'boolean - :group 'ispell) + :type 'boolean) (defvar-local ispell-local-dictionary-overridden nil "Non-nil means the user has explicitly set this buffer's Ispell dictionary.") @@ -366,8 +339,7 @@ calling \\[ispell-change-dictionary] with that value. This variable is automatically set when defined in the file with either `ispell-dictionary-keyword' or the Local Variable syntax." :type '(choice string - (const :tag "default" nil)) - :group 'ispell) + (const :tag "default" nil))) ;;;###autoload (put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p) @@ -376,16 +348,14 @@ is automatically set when defined in the file with either (defcustom ispell-dictionary nil "Default dictionary to use if `ispell-local-dictionary' is nil." :type '(choice string - (const :tag "default" nil)) - :group 'ispell) + (const :tag "default" nil))) (defcustom ispell-extra-args nil "If non-nil, a list of extra switches to pass to the Ispell program. For example, (\"-W\" \"3\") to cause it to accept all 1-3 character words as correct. See also `ispell-dictionary-alist', which may be used for language-specific arguments." - :type '(repeat string) - :group 'ispell) + :type '(repeat string)) @@ -400,8 +370,7 @@ such as \"&\". See `ispell-html-skip-alists' for more details. This variable affects spell-checking of HTML, XML, and SGML files." :type '(choice (const :tag "always" t) (const :tag "never" nil) - (const :tag "use-mode-name" use-mode-name)) - :group 'ispell) + (const :tag "use-mode-name" use-mode-name))) (make-variable-buffer-local 'ispell-skip-html) @@ -427,8 +396,7 @@ re-start Emacs." (const "~nroff") (const "~list") (const "~latin1") (const "~latin3") (const :tag "default" nil)) - (coding-system :tag "Coding System"))) - :group 'ispell) + (coding-system :tag "Coding System")))) (defvar ispell-dictionary-base-alist diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el index e48649bae37..f63894b8150 100644 --- a/lisp/textmodes/makeinfo.el +++ b/lisp/textmodes/makeinfo.el @@ -59,16 +59,14 @@ (defcustom makeinfo-run-command "makeinfo" "Command used to run `makeinfo' subjob. The name of the file is appended to this string, separated by a space." - :type 'string - :group 'makeinfo) + :type 'string) (defcustom makeinfo-options "--fill-column=70" "String containing options for running `makeinfo'. Do not include `--footnote-style' or `--paragraph-indent'; the proper way to specify those is with the Texinfo commands `@footnotestyle' and `@paragraphindent'." - :type 'string - :group 'makeinfo) + :type 'string) (require 'texinfo) diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 96edfd6de36..472c4069612 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -96,7 +96,6 @@ lines that start paragraphs from lines that separate them. If the variable `use-hard-newlines' is non-nil, then only lines following a hard newline are considered to match." - :group 'paragraphs :type 'regexp) (put 'paragraph-start 'safe-local-variable 'stringp) @@ -114,7 +113,6 @@ This is matched against the text at the left margin, which is not necessarily the beginning of the line, so it should not use \"^\" as an anchor. This ensures that the paragraph functions will work equally within a region of text indented by a margin setting." - :group 'paragraphs :type 'regexp) (put 'paragraph-separate 'safe-local-variable 'stringp) @@ -149,7 +147,6 @@ regexp describing the end of a sentence, when the value of the variable This value is used by the function `sentence-end' to construct the regexp describing the end of a sentence, when the value of the variable `sentence-end' is nil. See Info node `(elisp)Standard Regexps'." - :group 'paragraphs :type 'string) (put 'sentence-end-without-space 'safe-local-variable 'stringp) @@ -161,13 +158,11 @@ All paragraph boundaries also end sentences, regardless. The value nil means to use the default value defined by the function `sentence-end'. You should always use this function to obtain the value of this variable." - :group 'paragraphs :type '(choice regexp (const :tag "Use default value" nil))) (put 'sentence-end 'safe-local-variable 'string-or-null-p) (defcustom sentence-end-base "[.?!…‽][]\"'”’)}»›]*" "Regexp matching the basic end of a sentence, not including following space." - :group 'paragraphs :type 'regexp :version "25.1") (put 'sentence-end-base 'safe-local-variable 'stringp) @@ -197,14 +192,12 @@ in between. See Info node `(elisp)Standard Regexps'." (defcustom page-delimiter "^\014" "Regexp describing line-beginnings that separate pages." - :group 'paragraphs :type 'regexp) (put 'page-delimiter 'safe-local-variable 'stringp) (defcustom paragraph-ignore-fill-prefix nil "Non-nil means the paragraph commands are not affected by `fill-prefix'. This is desirable in modes where blank lines are the paragraph delimiters." - :group 'paragraphs :type 'boolean) (put 'paragraph-ignore-fill-prefix 'safe-local-variable 'booleanp) diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 3cb1043545a..1368af01bac 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -37,28 +37,22 @@ (defcustom picture-rectangle-ctl ?+ "Character `picture-draw-rectangle' uses for top left corners." - :type 'character - :group 'picture) + :type 'character) (defcustom picture-rectangle-ctr ?+ "Character `picture-draw-rectangle' uses for top right corners." - :type 'character - :group 'picture) + :type 'character) (defcustom picture-rectangle-cbr ?+ "Character `picture-draw-rectangle' uses for bottom right corners." - :type 'character - :group 'picture) + :type 'character) (defcustom picture-rectangle-cbl ?+ "Character `picture-draw-rectangle' uses for bottom left corners." - :type 'character - :group 'picture) + :type 'character) (defcustom picture-rectangle-v ?| "Character `picture-draw-rectangle' uses for vertical lines." - :type 'character - :group 'picture) + :type 'character) (defcustom picture-rectangle-h ?- "Character `picture-draw-rectangle' uses for horizontal lines." - :type 'character - :group 'picture) + :type 'character) ;; Picture Movement Commands @@ -409,8 +403,7 @@ character `\\' in the set it must be preceded by itself: \"\\\\\". The command \\[picture-tab-search] is defined to move beneath (or to) a character belonging to this set independent of the tab stops list." - :type 'string - :group 'picture) + :type 'string) (defun picture-set-tab-stops (&optional arg) "Set value of `tab-stop-list' according to context of this line. @@ -682,8 +675,7 @@ Leaves the region surrounding the rectangle." (defcustom picture-mode-hook nil "If non-nil, its value is called on entry to Picture mode. Picture mode is invoked by the command \\[picture-mode]." - :type 'hook - :group 'picture) + :type 'hook) (defvar picture-mode-old-local-map) (defvar picture-mode-old-mode-name) diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el index bff57128c51..2f3e0243ef3 100644 --- a/lisp/textmodes/refbib.el +++ b/lisp/textmodes/refbib.el @@ -65,8 +65,7 @@ (defcustom r2b-trace-on nil "Non-nil means trace conversion." - :type 'boolean - :group 'refbib) + :type 'boolean) (defcustom r2b-journal-abbrevs '( @@ -83,8 +82,7 @@ letter, even if it really doesn't. \(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string \"Artificial Intelligence\", but would replace Ijcai81 with the BibTeX macro \"ijcai7\"." - :type '(repeat (list string string)) - :group 'refbib) + :type '(repeat (list string string))) (defcustom r2b-booktitle-abbrevs '( @@ -101,8 +99,7 @@ should be listed as beginning with a capital letter, even if it doesn't. \(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string \"Artificial Intelligence\", but would replace Ijcai81 with the BibTeX macro \"ijcai7\"." - :type '(repeat (list string string)) - :group 'refbib) + :type '(repeat (list string string))) (defcustom r2b-proceedings-list '() @@ -119,8 +116,7 @@ a conference, and its expansion is the BibTeX macro \"ijcai7\". Then expansion were \"Proceedings of the Seventh International Conference on Artificial Intelligence\", then you would NOT need to include Ijcai81 in `r2b-proceedings-list' (although it wouldn't cause an error)." - :type '(repeat (list string string)) - :group 'refbib) + :type '(repeat (list string string))) (defvar r2b-additional-stop-words "Some\\|What" @@ -129,8 +125,7 @@ This is in addition to the `r2b-capitalize-title-stop-words'.") (defcustom r2b-delimit-with-quote t "If true, then use \" to delimit fields, otherwise use braces." - :type 'boolean - :group 'refbib) + :type 'boolean) ;********************************************************** ; Utility Functions @@ -205,13 +200,11 @@ This is in addition to the `r2b-capitalize-title-stop-words'.") (defcustom r2b-out-buf-name "*Out*" "Name of buffer for output from refer-to-bibtex." - :type 'string - :group 'refbib) + :type 'string) (defcustom r2b-log-name "*Log*" "Name of buffer for logs errors from refer-to-bibtex." - :type 'string - :group 'refbib) + :type 'string) (defvar r2b-in-buf nil) (defvar r2b-out-buf nil) diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el index ae1f7781686..c2bf90f37bb 100644 --- a/lisp/textmodes/refer.el +++ b/lisp/textmodes/refer.el @@ -91,8 +91,7 @@ the default search path. Since Refer does not know that default path, it cannot search it. Include that path explicitly in your BIBINPUTS environment if you really want it searched (which is not likely to happen anyway)." - :type '(choice (repeat directory) (const bibinputs) (const texinputs)) - :group 'refer) + :type '(choice (repeat directory) (const bibinputs) (const texinputs))) (defcustom refer-bib-files 'dir "List of \\.bib files to search for references, @@ -110,16 +109,14 @@ If `refer-bib-files' is nil, auto or dir, it is setq'd to the appropriate list of files when it is first used if `refer-cache-bib-files' is t. If `refer-cache-bib-files' is nil, the list of \\.bib files to use is re-read each time it is needed." - :type '(choice (repeat file) (const nil) (const auto) (const dir)) - :group 'refer) + :type '(choice (repeat file) (const nil) (const auto) (const dir))) (defcustom refer-cache-bib-files t "Variable determining whether the value of `refer-bib-files' should be cached. If t, initialize the value of refer-bib-files the first time it is used. If nil, re-read the list of \\.bib files depending on the value of `refer-bib-files' each time it is needed." - :type 'boolean - :group 'refer) + :type 'boolean) (defcustom refer-bib-files-regexp "\\\\bibliography" "Regexp matching a bibliography file declaration. @@ -131,8 +128,7 @@ command is expected to specify a file name, or a list of comma-separated file names, within curly braces. If a specified file doesn't exist and has no extension, a \\.bib extension is automatically tried." - :type 'regexp - :group 'refer) + :type 'regexp) (make-variable-buffer-local 'refer-bib-files) (make-variable-buffer-local 'refer-cache-bib-files) diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 820ee38d101..6a72ebb3321 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -193,24 +193,20 @@ (defcustom remember-mode-hook nil "Functions run upon entering `remember-mode'." :type 'hook - :options '(flyspell-mode turn-on-auto-fill org-remember-apply-template) - :group 'remember) + :options '(flyspell-mode turn-on-auto-fill org-remember-apply-template)) (defcustom remember-in-new-frame nil "Non-nil means use a separate frame for capturing remember data." - :type 'boolean - :group 'remember) + :type 'boolean) (defcustom remember-register ?R "The register in which the window configuration is stored." - :type 'character - :group 'remember) + :type 'character) (defcustom remember-filter-functions nil "Functions run to filter remember data. All functions are run in the remember buffer." - :type 'hook - :group 'remember) + :type 'hook) (defcustom remember-handler-functions '(remember-append-to-file) "Functions run to process remember data. @@ -223,13 +219,11 @@ recorded somewhere by that function." remember-append-to-file remember-store-in-files remember-diary-extract-entries - org-remember-handler) - :group 'remember) + org-remember-handler)) (defcustom remember-all-handler-functions nil "If non-nil every function in `remember-handler-functions' is called." - :type 'boolean - :group 'remember) + :type 'boolean) ;; See below for more user variables. @@ -240,16 +234,14 @@ recorded somewhere by that function." (defcustom remember-save-after-remembering t "Non-nil means automatically save after remembering." - :type 'boolean - :group 'remember) + :type 'boolean) ;;; User Functions: (defcustom remember-annotation-functions '(buffer-file-name) "Hook that returns an annotation to be inserted into the remember buffer." :type 'hook - :options '(org-remember-annotation buffer-file-name) - :group 'remember) + :options '(org-remember-annotation buffer-file-name)) (defvar remember-annotation nil "Current annotation.") @@ -258,13 +250,11 @@ recorded somewhere by that function." (defcustom remember-before-remember-hook nil "Functions run before switching to the *Remember* buffer." - :type 'hook - :group 'remember) + :type 'hook) (defcustom remember-run-all-annotation-functions-flag nil "Non-nil means use all annotations returned by `remember-annotation-functions'." - :type 'boolean - :group 'remember) + :type 'boolean) ;;;###autoload (defun remember (&optional initial) @@ -337,13 +327,11 @@ With a prefix or a visible region, use the region as INITIAL." (defcustom remember-mailbox "~/Mail/remember" "The file in which to store remember data as mail." - :type 'file - :group 'remember) + :type 'file) (defcustom remember-default-priority "medium" "The default priority for remembered mail messages." - :type 'string - :group 'remember) + :type 'string) (defun remember-store-in-mailbox () "Store remember data as if it were incoming mail. @@ -396,19 +384,16 @@ exists) might be changed." (with-current-buffer buf (set-visited-file-name (expand-file-name remember-data-file)))))) - :initialize 'custom-initialize-default - :group 'remember) + :initialize 'custom-initialize-default) (defcustom remember-leader-text "** " "The text used to begin each remember item." - :type 'string - :group 'remember) + :type 'string) (defcustom remember-time-format "%a %b %d %H:%M:%S %Y" "The format for time stamp, passed to `format-time-string'. The default emulates `current-time-string' for backward compatibility." :type 'string - :group 'remember :version "27.1") (defcustom remember-text-format-function nil @@ -416,7 +401,6 @@ The default emulates `current-time-string' for backward compatibility." The function receives the remembered text as argument and should return the text to be remembered." :type '(choice (const nil) function) - :group 'remember :version "28.1") (defun remember-append-to-file () @@ -465,16 +449,14 @@ If you want to remember a region, supply a universal prefix to "The directory in which to store remember data as files. Used by `remember-store-in-files'." :type 'directory - :version "24.4" - :group 'remember) + :version "24.4") (defcustom remember-directory-file-name-format "%Y-%m-%d_%T-%z" "Format string for the file name in which to store unprocessed data. This is passed to `format-time-string'. Used by `remember-store-in-files'." :type 'string - :version "24.4" - :group 'remember) + :version "24.4") (defun remember-store-in-files () "Store remember data in a file in `remember-data-directory'. @@ -511,8 +493,7 @@ Most useful for remembering things from other applications." (defcustom remember-diary-file nil "File for extracted diary entries. If this is nil, then `diary-file' will be used instead." - :type '(choice (const :tag "diary-file" nil) file) - :group 'remember) + :type '(choice (const :tag "diary-file" nil) file)) (defvar calendar-date-style) ; calendar.el diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 7799cdb5529..278cd0cd848 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -54,20 +54,17 @@ ;;;###autoload (defcustom texinfo-open-quote (purecopy "``") "String inserted by typing \\[texinfo-insert-quote] to open a quotation." - :type 'string - :group 'texinfo) + :type 'string) ;;;###autoload (defcustom texinfo-close-quote (purecopy "''") "String inserted by typing \\[texinfo-insert-quote] to close a quotation." - :type 'string - :group 'texinfo) + :type 'string) (defcustom texinfo-mode-hook nil "Normal hook run when entering Texinfo mode." :type 'hook - :options '(turn-on-auto-fill flyspell-mode) - :group 'texinfo) + :options '(turn-on-auto-fill flyspell-mode)) ;;; Autoloads: @@ -349,8 +346,7 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") (defface texinfo-heading '((t (:inherit font-lock-function-name-face))) - "Face used for section headings in `texinfo-mode'." - :group 'texinfo) + "Face used for section headings in `texinfo-mode'.") (defvar texinfo-font-lock-keywords `(;; All but the first had an OVERRIDE of t. @@ -962,32 +958,27 @@ to jump to the corresponding spot in the Texinfo source file." (defcustom texinfo-texi2dvi-command "texi2dvi" "Command used by `texinfo-tex-buffer' to run TeX and texindex on a buffer." - :type 'string - :group 'texinfo) + :type 'string) (defcustom texinfo-texi2dvi-options "" "Command line options for `texinfo-texi2dvi-command'." :type 'string - :group 'texinfo :version "28.1") (defcustom texinfo-tex-command "tex" "Command used by `texinfo-tex-region' to run TeX on a region." - :type 'string - :group 'texinfo) + :type 'string) (defcustom texinfo-texindex-command "texindex" "Command used by `texinfo-texindex' to sort unsorted index files." - :type 'string - :group 'texinfo) + :type 'string) (defcustom texinfo-delete-from-print-queue-command "lprm" "Command string used to delete a job from the line printer queue. Command is used by \\[texinfo-delete-from-print-queue] based on number provided by a previous \\[tex-show-print-queue] command." - :type 'string - :group 'texinfo) + :type 'string) (defvar texinfo-tex-trailer "@bye" "String appended after a region sent to TeX by `texinfo-tex-region'.") diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 33a976aa7b0..1d90562ae22 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -66,7 +66,6 @@ non-capturing groups can be used for grouping prior to the part of the regexp matching the white space). The pattern is matched case-sensitive regardless of the value of `case-fold-search' setting." :version "25.1" - :group 'tildify :type 'regexp :safe t) @@ -90,7 +89,6 @@ by the hard space character. The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." - :group 'tildify :type '(repeat (cons :tag "Entry for major mode" (choice (const :tag "Default" t) (symbol :tag "Major mode")) @@ -110,7 +108,6 @@ might be used for other modes if compatible encoding is used. If nil, current major mode has no way to represent a hard space." :version "25.1" - :group 'tildify :type '(choice (const :tag "Space character (no hard-space representation)" " ") (const :tag "No-break space (U+00A0)" "\u00A0") @@ -133,7 +130,6 @@ STRING defines the hard space, which is inserted at places defined by The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." - :group 'tildify :type '(repeat (cons :tag "Entry for major mode" (choice (const :tag "Default" t) (symbol :tag "Major mode")) @@ -164,7 +160,6 @@ or better still: See `tildify-foreach-ignore-environments' function for other ways to use the variable." :version "25.1" - :group 'tildify :type 'function) (defcustom tildify-ignored-environments-alist () @@ -183,7 +178,6 @@ MAJOR-MODE defines major mode, for which the item applies. It can be either: See `tildify-foreach-ignore-environments' function for description of BEG-REGEX and END-REGEX." - :group 'tildify :type '(repeat (cons :tag "Entry for major mode" (choice (const :tag "Default" t) @@ -416,19 +410,16 @@ If the pattern matches `looking-back', a hard space needs to be inserted instead of a space at point. The regexp is always case sensitive, regardless of the current `case-fold-search' setting." :version "25.1" - :group 'tildify :type 'regexp) (defcustom tildify-space-predicates '(tildify-space-region-predicate) "A list of predicate functions for `tildify-space' function." :version "25.1" - :group 'tildify :type '(repeat function)) (defcustom tildify-double-space-undos t "Weather `tildify-space' should undo hard space when space is typed again." :version "25.1" - :group 'tildify :type 'boolean) ;;;###autoload diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el index d072ab16c3c..9c0ed8fbd55 100644 --- a/lisp/textmodes/two-column.el +++ b/lisp/textmodes/two-column.el @@ -133,26 +133,22 @@ '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name minor-mode-alist "%n" mode-line-process ")%]%-") "Value of `mode-line-format' for a buffer in two-column minor mode." - :type 'sexp - :group 'two-column) + :type 'sexp) (defcustom 2C-other-buffer-hook 'text-mode "Hook run in new buffer when it is associated with current one." - :type 'function - :group 'two-column) + :type 'function) (defcustom 2C-separator "" "A string inserted between the two columns when merging. This gets set locally by \\[2C-split]." - :type 'string - :group 'two-column) + :type 'string) (put '2C-separator 'permanent-local t) (defcustom 2C-window-width 40 "The width of the first column. (Must be at least `window-min-width'.) This value is local for every buffer that sets it." - :type 'integer - :group 'two-column) + :type 'integer) (make-variable-buffer-local '2C-window-width) (put '2C-window-width 'permanent-local t) @@ -160,13 +156,11 @@ This value is local for every buffer that sets it." "Base for calculating `fill-column' for a buffer in two-column minor mode. The value of `fill-column' becomes `2C-window-width' for this buffer minus this value." - :type 'integer - :group 'two-column) + :type 'integer) (defcustom 2C-autoscroll t "If non-nil, Emacs attempts to keep the two column's buffers aligned." - :type 'boolean - :group 'two-column) + :type 'boolean) (defvar 2C-mode-map From 43ecde85786ccbf4c07d535f08fd74c82a0af31b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 12:50:19 +0100 Subject: [PATCH 179/297] Introduce an :interactive keyword for `defined-derived-mode' * doc/lispref/modes.texi (Derived Modes): Document it. * lisp/emacs-lisp/derived.el (define-derived-mode): Introduce a new :interactive keyword. --- doc/lispref/modes.texi | 7 +++++++ etc/NEWS | 6 ++++++ lisp/emacs-lisp/derived.el | 7 ++++++- 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 3a4828c8fab..7b8ab4cb4dd 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -861,6 +861,13 @@ abbrev table as @var{parent}, or @code{fundamental-mode-abbrev-table} if @var{parent} is @code{nil}. (Again, a @code{nil} value is @emph{not} equivalent to not specifying this keyword.) +@item :interactive +Modes are interactive commands by default. If you specify a +@code{nil} value, the mode defined here won't be interactive. This is +useful for modes that are never meant to be activated by users +manually, but are only supposed to be used in some specially-formatted +buffer. + @item :group If this is specified, the value should be the customization group for this mode. (Not all major modes have one.) The command diff --git a/etc/NEWS b/etc/NEWS index 7e224b411f8..08e1e94d83d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2271,6 +2271,12 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', This permanently buffer-local variable holds a list of currently enabled minor modes in the current buffer (as a list of symbols). ++++ +** 'defined-derived-mode' now takes an :interactive argument. +This can be used to control whether the defined mode is a command +or not, and is useful when defining commands that aren't meant to be +used by users directly. + ** The 'values' variable is now obsolete. --- diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 54528b2fb91..43d6dfd3c81 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -141,6 +141,9 @@ KEYWORD-ARGS: :after-hook FORM A single lisp form which is evaluated after the mode hooks have been run. It should not be quoted. + :interactive BOOLEAN + Whether the derived mode should be `interactive' or not. + The default is t. BODY: forms to execute just before running the hooks for the new mode. Do not use `interactive' here. @@ -194,6 +197,7 @@ See Info node `(elisp)Derived Modes' for more details. (declare-syntax t) (hook (derived-mode-hook-name child)) (group nil) + (interactive t) (after-hook nil)) ;; Process the keyword args. @@ -203,6 +207,7 @@ See Info node `(elisp)Derived Modes' for more details. (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil)) (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil)) (:after-hook (setq after-hook (pop body))) + (:interactive (setq interactive (pop body))) (_ (pop body)))) (setq docstring (derived-mode-make-docstring @@ -246,7 +251,7 @@ No problems result if this variable is not bound. (defun ,child () ,docstring - (interactive) + ,(and interactive '(interactive)) ; Run the parent. (delay-mode-hooks From 8d517daf770e8c6bd05e040b3bd3402626dbd9ef Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 12:52:00 +0100 Subject: [PATCH 180/297] Fix how `shell-mode' avoids being called interactively * lisp/shell.el (shell-mode): Make noninteractive instead of erroring out after being called. --- lisp/shell.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/shell.el b/lisp/shell.el index 9238ad1e8a0..53f5d0b6f1c 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -556,8 +556,7 @@ Variables `comint-output-filter-functions', a hook, and `comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output' control whether input and output cause the window to scroll to the end of the buffer." - (when (called-interactively-p 'any) - (error "Can't be called interactively; did you mean `shell-script-mode' instead?")) + :interactive nil (setq comint-prompt-regexp shell-prompt-pattern) (shell-completion-vars) (setq-local paragraph-separate "\\'") From 58e0c8ee86e2c36245f1c5a1483f1c73600b4914 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 13:21:24 +0100 Subject: [PATCH 181/297] Extend the syntax of `interactive' to list applicable modes * doc/lispref/commands.texi (Using Interactive): Document the extended `interactive' form. * doc/lispref/loading.texi (Autoload): Document list-of-modes form. * lisp/emacs-lisp/autoload.el (make-autoload): Pick the list of modes from `interactive' out of the functions. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Allow for the extended `interactive' form. * src/callint.c (Finteractive): Document the extended form. * src/data.c (Finteractive_form): Return the interactive form in the old format (even when there's an extended `interactive') to avoid having other parts of Emacs be aware of this. (Fcommand_modes): New defun. * src/emacs-module.c (GCALIGNED_STRUCT): Allow for modules to return command modes. * src/lisp.h: New function module_function_command_modes. --- doc/lispref/commands.texi | 19 +++++++- doc/lispref/loading.texi | 3 ++ etc/NEWS | 8 ++++ lisp/emacs-lisp/autoload.el | 15 ++++-- lisp/emacs-lisp/bytecomp.el | 40 ++++++++++------ src/callint.c | 9 +++- src/data.c | 92 +++++++++++++++++++++++++++++++++++-- src/emacs-module.c | 8 +++- src/eval.c | 9 +++- src/lisp.h | 3 ++ src/lread.c | 1 + 11 files changed, 179 insertions(+), 28 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 3a2c7d019ef..d60745a825b 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -156,7 +156,7 @@ commands by adding the @code{interactive} form to them. makes a Lisp function an interactively-callable command, and how to examine a command's @code{interactive} form. -@defspec interactive arg-descriptor +@defspec interactive &optional arg-descriptor &rest modes This special form declares that a function is a command, and that it may therefore be called interactively (via @kbd{M-x} or by entering a key sequence bound to it). The argument @var{arg-descriptor} declares @@ -177,6 +177,23 @@ forms are executed; at this time, if the @code{interactive} form occurs within the body, the form simply returns @code{nil} without even evaluating its argument. +The @var{modes} list allows specifying which modes the command is +meant to be used in. This affects, for instance, completion in +@kbd{M-x} (commands won't be offered as completions if they don't +match (using @code{derived-mode-p}) the current major mode, or if the +mode is a minor mode, whether it's switched on in the current buffer). +This will also make @kbd{C-h m} list these commands (if they aren't +bound to any keys). + +For instance: + +@lisp +(interactive "p" dired-mode) +@end lisp + +This will mark the command as applicable for modes derived from +@code{dired-mode} only. + By convention, you should put the @code{interactive} form in the function body, as the first top-level form. If there is an @code{interactive} form in both the @code{interactive-form} symbol diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 33f37331947..8c6aeb04721 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -510,6 +510,9 @@ specification is not given here; it's not needed unless the user actually calls @var{function}, and when that happens, it's time to load the real definition. +If @var{interactive} is a list, it is interpreted as a list of modes +this command is applicable for. + You can autoload macros and keymaps as well as ordinary functions. Specify @var{type} as @code{macro} if @var{function} is really a macro. Specify @var{type} as @code{keymap} if @var{function} is really a diff --git a/etc/NEWS b/etc/NEWS index 08e1e94d83d..d8f0bc60726 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2266,6 +2266,14 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 ++++ +** The 'interactive' syntax has been extended to allow listing applicable modes. +Forms like '(interactive "p" dired-mode)' can be used to annotate the +commands as being applicable for modes derived from 'dired-mode', +or if the mode is a minor mode, that the current buffer has that +minor mode activated. Note that using this form will create byte code +that is not compatible with byte code in previous Emacs versions. + +++ ** New buffer-local variable 'minor-modes'. This permanently buffer-local variable holds a list of currently diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index ec7492dd4b1..ae17039645a 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -141,9 +141,12 @@ expression, in which case we want to handle forms differently." ((stringp (car-safe rest)) (car rest)))) ;; Look for an interactive spec. (interactive (pcase body - ((or `((interactive . ,_) . ,_) - `(,_ (interactive . ,_) . ,_)) - t)))) + ((or `((interactive . ,iargs) . ,_) + `(,_ (interactive . ,iargs) . ,_)) + ;; List of modes or just t. + (if (nthcdr 1 iargs) + (list 'quote (nthcdr 1 iargs)) + t))))) ;; Add the usage form at the end where describe-function-1 ;; can recover it. (when (consp args) (setq doc (help-add-fundoc-usage doc args))) @@ -207,7 +210,11 @@ expression, in which case we want to handle forms differently." easy-mmode-define-minor-mode define-minor-mode)) t) - (eq (car-safe (car body)) 'interactive)) + (and (eq (car-safe (car body)) 'interactive) + ;; List of modes or just t. + (or (if (nthcdr 1 (car body)) + (list 'quote (nthcdr 1 (car body))) + t)))) ,(if macrop ''macro nil)))) ;; For defclass forms, use `eieio-defclass-autoload'. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 89068a14f02..5c6b9c2e39a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2939,7 +2939,8 @@ for symbols generated by the byte compiler itself." ;; unless it is the last element of the body. (if (cdr body) (setq body (cdr body)))))) - (int (assq 'interactive body))) + (int (assq 'interactive body)) + command-modes) (when lexical-binding (dolist (var arglistvars) (when (assq var byte-compile--known-dynamic-vars) @@ -2951,9 +2952,10 @@ for symbols generated by the byte compiler itself." (if (eq int (car body)) (setq body (cdr body))) (cond ((consp (cdr int)) - (if (cdr (cdr int)) - (byte-compile-warn "malformed interactive spec: %s" - (prin1-to-string int))) + (unless (seq-every-p #'symbolp (cdr (cdr int))) + (byte-compile-warn "malformed interactive specc: %s" + (prin1-to-string int))) + (setq command-modes (cdr (cdr int))) ;; If the interactive spec is a call to `list', don't ;; compile it, because `call-interactively' looks at the ;; args of `list'. Actually, compile it to get warnings, @@ -2964,14 +2966,15 @@ for symbols generated by the byte compiler itself." (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) - (if (and (eq (car-safe form) 'list) - ;; For code using lexical-binding, form is not - ;; valid lisp, but rather an intermediate form - ;; which may include "calls" to - ;; internal-make-closure (Bug#29988). - (not lexical-binding)) - nil - (setq int `(interactive ,newform))))) + (setq int + (if (and (eq (car-safe form) 'list) + ;; For code using lexical-binding, form is not + ;; valid lisp, but rather an intermediate form + ;; which may include "calls" to + ;; internal-make-closure (Bug#29988). + (not lexical-binding)) + `(interactive ,form) + `(interactive ,newform))))) ((cdr int) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))))) @@ -3002,9 +3005,16 @@ for symbols generated by the byte compiler itself." (list (help-add-fundoc-usage doc arglist))) ((or doc int) (list doc))) - ;; optionally, the interactive spec. - (if int - (list (nth 1 int)))))))) + ;; optionally, the interactive spec (and the modes the + ;; command applies to). + (cond + ;; We have some command modes, so use the vector form. + (command-modes + (list (vector (nth 1 int) command-modes))) + ;; No command modes, use the simple form with just the + ;; interactive spec. + (int + (list (nth 1 int))))))))) (defvar byte-compile-reserved-constants 0) diff --git a/src/callint.c b/src/callint.c index d3f49bc35d1..18624637843 100644 --- a/src/callint.c +++ b/src/callint.c @@ -104,7 +104,14 @@ If the string begins with `^' and `shift-select-mode' is non-nil, Emacs first calls the function `handle-shift-selection'. You may use `@', `*', and `^' together. They are processed in the order that they appear, before reading any arguments. -usage: (interactive &optional ARG-DESCRIPTOR) */ + +If MODES is present, it should be a list of mode names (symbols) that +this command is applicable for. The main effect of this is that +`M-x TAB' (by default) won't list this command if the current buffer's +mode doesn't match the list. That is, if either the major mode isn't +derived from them, or (when it's a minor mode) the mode isn't in effect. + +usage: (interactive &optional ARG-DESCRIPTOR &rest MODES) */ attributes: const) (Lisp_Object args) { diff --git a/src/data.c b/src/data.c index 38cde0ff8b2..7bddc039f6f 100644 --- a/src/data.c +++ b/src/data.c @@ -904,7 +904,17 @@ Value, if non-nil, is a list (interactive SPEC). */) else if (COMPILEDP (fun)) { if (PVSIZE (fun) > COMPILED_INTERACTIVE) - return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); + { + Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); + if (VECTORP (form)) + /* The vector form is the new form, where the first + element is the interactive spec, and the second is the + command modes. */ + return list2 (Qinteractive, AREF (form, 0)); + else + /* Old form -- just the interactive spec. */ + return list2 (Qinteractive, form); + } } #ifdef HAVE_MODULES else if (MODULE_FUNCTIONP (fun)) @@ -920,10 +930,80 @@ Value, if non-nil, is a list (interactive SPEC). */) else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); - if (EQ (funcar, Qclosure)) - return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); - else if (EQ (funcar, Qlambda)) - return Fassq (Qinteractive, Fcdr (XCDR (fun))); + if (EQ (funcar, Qclosure) + || EQ (funcar, Qlambda)) + { + Lisp_Object form = Fcdr (XCDR (fun)); + if (EQ (funcar, Qclosure)) + form = Fcdr (form); + Lisp_Object spec = Fassq (Qinteractive, form); + if (NILP (Fcdr (Fcdr (spec)))) + return spec; + else + return list2 (Qinteractive, Fcar (Fcdr (spec))); + } + } + return Qnil; +} + +DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0, + doc: /* Return the modes COMMAND is defined for. +If COMMAND is not a command, the return value is nil. +The value, if non-nil, is a list of mode name symbols. */) + (Lisp_Object command) +{ + Lisp_Object fun = indirect_function (command); /* Check cycles. */ + + if (NILP (fun)) + return Qnil; + + fun = command; + while (SYMBOLP (fun)) + fun = Fsymbol_function (fun); + + if (SUBRP (fun)) + { + if (!NILP (XSUBR (fun)->command_modes)) + return XSUBR (fun)->command_modes; + } + else if (COMPILEDP (fun)) + { + Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); + if (VECTORP (form)) + /* New form -- the second element is the command modes. */ + return AREF (form, 1); + else + /* Old .elc file -- no command modes. */ + return Qnil; + } +#ifdef HAVE_MODULES + else if (MODULE_FUNCTIONP (fun)) + { + Lisp_Object form + = module_function_command_modes (XMODULE_FUNCTION (fun)); + if (! NILP (form)) + return form; + } +#endif + else if (AUTOLOADP (fun)) + { + Lisp_Object modes = Fnth (make_int (3), fun); + if (CONSP (modes)) + return modes; + else + return Qnil; + } + else if (CONSP (fun)) + { + Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qclosure) + || EQ (funcar, Qlambda)) + { + Lisp_Object form = Fcdr (XCDR (fun)); + if (EQ (funcar, Qclosure)) + form = Fcdr (form); + return Fcdr (Fcdr (Fassq (Qinteractive, form))); + } } return Qnil; } @@ -3908,6 +3988,7 @@ syms_of_data (void) defsubr (&Sindirect_variable); defsubr (&Sinteractive_form); + defsubr (&Scommand_modes); defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); @@ -4030,6 +4111,7 @@ This variable cannot be set; trying to do so will signal an error. */); DEFSYM (Qunlet, "unlet"); DEFSYM (Qset, "set"); DEFSYM (Qset_default, "set-default"); + DEFSYM (Qcommand_modes, "command-modes"); defsubr (&Sadd_variable_watcher); defsubr (&Sremove_variable_watcher); defsubr (&Sget_variable_watchers); diff --git a/src/emacs-module.c b/src/emacs-module.c index 894dffcf21e..f8fb54c0728 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -549,7 +549,7 @@ struct Lisp_Module_Function union vectorlike_header header; /* Fields traced by GC; these must come first. */ - Lisp_Object documentation, interactive_form; + Lisp_Object documentation, interactive_form, command_modes; /* Fields ignored by GC. */ ptrdiff_t min_arity, max_arity; @@ -646,6 +646,12 @@ module_function_interactive_form (const struct Lisp_Module_Function *fun) return fun->interactive_form; } +Lisp_Object +module_function_command_modes (const struct Lisp_Module_Function *fun) +{ + return fun->command_modes; +} + static emacs_value module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs, emacs_value *args) diff --git a/src/eval.c b/src/eval.c index 91fc4e68377..542d7f686e6 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2080,14 +2080,21 @@ then strings and vectors are not accepted. */) DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0, doc: /* Define FUNCTION to autoload from FILE. FUNCTION is a symbol; FILE is a file name string to pass to `load'. + Third arg DOCSTRING is documentation for the function. -Fourth arg INTERACTIVE if non-nil says function can be called interactively. + +Fourth arg INTERACTIVE if non-nil says function can be called +interactively. If INTERACTIVE is a list, it is interpreted as a list +of modes the function is applicable for. + Fifth arg TYPE indicates the type of the object: nil or omitted says FUNCTION is a function, `keymap' says FUNCTION is really a keymap, and `macro' or t says FUNCTION is really a macro. + Third through fifth args give info about the real definition. They default to nil. + If FUNCTION is already defined other than as an autoload, this does nothing and returns nil. */) (Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object interactive, Lisp_Object type) diff --git a/src/lisp.h b/src/lisp.h index 0847324d1ff..697dd89363c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2060,6 +2060,7 @@ struct Lisp_Subr const char *symbol_name; const char *intspec; EMACS_INT doc; + Lisp_Object command_modes; } GCALIGNED_STRUCT; union Aligned_Lisp_Subr { @@ -4221,6 +4222,8 @@ extern Lisp_Object module_function_documentation (struct Lisp_Module_Function const *); extern Lisp_Object module_function_interactive_form (const struct Lisp_Module_Function *); +extern Lisp_Object module_function_command_modes + (const struct Lisp_Module_Function *); extern module_funcptr module_function_address (struct Lisp_Module_Function const *); extern void *module_function_data (const struct Lisp_Module_Function *); diff --git a/src/lread.c b/src/lread.c index dea1b232fff..8b8ba93c607 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4467,6 +4467,7 @@ defsubr (union Aligned_Lisp_Subr *aname) XSETPVECTYPE (sname, PVEC_SUBR); XSETSUBR (tem, sname); set_symbol_function (sym, tem); + sname->command_modes = Qnil; } #ifdef NOTDEF /* Use fset in subr.el now! */ From 9291e7316f98ab0858b323f72047ffd5a23d9ac9 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 13:29:35 +0100 Subject: [PATCH 182/297] Add new 'declare' forms for command completion predicates * doc/lispref/functions.texi (Declare Form): Document the new `completion' and `modes' declarations. * lisp/simple.el (completion-with-modes-p): New helper functions. * lisp/emacs-lisp/byte-run.el (byte-run--set-completion) (byte-run--set-modes): (defun-declarations-alist): New declarations for `completion' and `modes'. --- doc/lispref/functions.texi | 10 ++++++++++ etc/NEWS | 9 +++++++++ lisp/emacs-lisp/byte-run.el | 15 ++++++++++++++- lisp/simple.el | 5 +++++ 4 files changed, 38 insertions(+), 1 deletion(-) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 414035f684b..1e3da8e3a5d 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2309,6 +2309,16 @@ form @code{(lambda (@var{arg}) @var{body})} in which case that function will additionally have access to the macro (or function)'s arguments and it will be passed to @code{gv-define-setter}. +@item (completion @var{completion-predicate}) +Declare @var{completion-predicate} as a function to determine whether +to include the symbol in the list of functions when asking for +completions in @kbd{M-x}. @var{completion-predicate} is called with +two parameters: The first parameter is the symbol, and the second is +the current buffer. + +@item (modes @var{modes}) +Specify that this command is meant to be applicable for @var{modes} +only. @end table @end defmac diff --git a/etc/NEWS b/etc/NEWS index d8f0bc60726..3b6467bf45c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2266,6 +2266,15 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 ++++ +** New forms to declare how completion should happen has been added. +'(declare (completion PREDICATE))' can be used as a general predicate +to say whether the command should be present when completing with +'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand +way of saying that the command should be present when completing from +buffers in major modes derived from MODE..., or, if it's a minor mode, +whether that minor mode is enabled in the current buffer. + +++ ** The 'interactive' syntax has been extended to allow listing applicable modes. Forms like '(interactive "p" dired-mode)' can be used to annotate the diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 88f362d24f0..30fcbf2b9cc 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -143,6 +143,17 @@ The return value of this function is not used." (list 'function-put (list 'quote f) ''lisp-indent-function (list 'quote val)))) +(defalias 'byte-run--set-completion + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''completion-predicate val))) + +(defalias 'byte-run--set-modes + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''completion-predicate `(lambda (_ b) + (completion-with-modes-p ,val b))))) + ;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist (list @@ -159,7 +170,9 @@ This may shift errors from run-time to compile-time.") If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (list 'compiler-macro #'byte-run--set-compiler-macro) (list 'doc-string #'byte-run--set-doc-string) - (list 'indent #'byte-run--set-indent)) + (list 'indent #'byte-run--set-indent) + (list 'completion #'byte-run--set-completion) + (list 'modes #'byte-run--set-modes)) "List associating function properties to their macro expansion. Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a function's declaration, diff --git a/lisp/simple.el b/lisp/simple.el index 0c5bcb66724..9057355a7ab 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1950,6 +1950,11 @@ to get different commands to edit and resubmit." (complete-with-action action obarray string pred))) #'commandp t nil 'extended-command-history))) +(defun completion-with-modes-p (modes buffer) + (apply #'provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + modes)) + (defun read-extended-command--affixation (command-names) (with-selected-window (or (minibuffer-selected-window) (selected-window)) (mapcar From 2bfcd93e83d264e6b801e43bfd1a78e345b8221d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 13:31:10 +0100 Subject: [PATCH 183/297] Mark easy-menu-do-define menus as "not interesting" * lisp/emacs-lisp/easymenu.el (easy-menu-do-define): Mark menu keymaps as "not interesting" when doing completion. --- lisp/emacs-lisp/easymenu.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 5303da3746c..39b3193b2f4 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -183,7 +183,10 @@ This is expected to be bound to a mouse event." :filter) 'identity) (symbol-function symbol))) - symbol))))) + symbol)))) + ;; These symbols are commands, but not interesting for users + ;; to `M-x TAB'. + (put symbol 'completion-predicate 'ignore)) (dolist (map (if (keymapp maps) (list maps) maps)) (define-key map (vector 'menu-bar (easy-menu-intern (car menu))) From c1ef7adeb649aa99a10c4bd3b6ce988b309da3cc Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 13:56:53 +0100 Subject: [PATCH 184/297] Add 'read-extended-command-predicate' * doc/emacs/m-x.texi (M-x): Document it. * doc/lispref/commands.texi (Interactive Call): Document it further. * lisp/simple.el (read-extended-command-predicate): New user option. (read-extended-command-predicate): Use it. (completion-in-mode-p): New function (the default predicate). --- doc/emacs/m-x.texi | 5 ++ doc/lispref/commands.texi | 9 +++ etc/NEWS | 5 ++ lisp/emacs-lisp/seq.el | 1 + lisp/simple.el | 131 ++++++++++++++++++++++++-------------- 5 files changed, 103 insertions(+), 48 deletions(-) diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi index 865220fb218..689125e7b4a 100644 --- a/doc/emacs/m-x.texi +++ b/doc/emacs/m-x.texi @@ -94,3 +94,8 @@ the command is followed by arguments. @kbd{M-x} works by running the command @code{execute-extended-command}, which is responsible for reading the name of another command and invoking it. + +@vindex read-extended-command-predicate + This command heeds the @code{read-extended-command-predicate} +variable, which will (by default) filter out commands that are not +applicable to the current major mode (or enabled minor modes). diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index d60745a825b..b3bcdf35c9f 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -773,6 +773,15 @@ part of the prompt. @result{} t @end group @end example + +@vindex read-extended-command-predicate +This command heeds the @code{read-extended-command-predicate} +variable, which will (by default) filter out commands that are not +applicable to the current major mode (or enabled minor modes). +@code{read-extended-command-predicate} will be called with two +parameters: The symbol that is to be included or not, and the current +buffer. If should return non-@code{nil} if the command is to be +included when completing. @end deffn @node Distinguish Interactive diff --git a/etc/NEWS b/etc/NEWS index 3b6467bf45c..9c3396d33af 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -251,6 +251,11 @@ commands. The new keystrokes are 'C-x x g' ('revert-buffer'), * Editing Changes in Emacs 28.1 ++++ +** New user option 'read-extended-command-predicate'. +This option controls how 'M-x TAB' performs completions. The default +predicate excludes modes for which the command is not applicable. + --- ** 'eval-expression' now no longer signals an error on incomplete expressions. Previously, typing 'M-: ( RET' would result in Emacs saying "End of diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 31c15fea90d..55ce6d9426d 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -455,6 +455,7 @@ negative integer or 0, nil is returned." (setq sequence (seq-drop sequence n))) (nreverse result)))) +;;;###autoload (cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn) "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2. Equality is defined by TESTFN if non-nil or by `equal' if nil." diff --git a/lisp/simple.el b/lisp/simple.el index 9057355a7ab..015fa9e4d55 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1900,55 +1900,90 @@ to get different commands to edit and resubmit." (defvar extended-command-history nil) (defvar execute-extended-command--last-typed nil) +(defcustom read-extended-command-predicate #'completion-in-mode-p + "Predicate to use to determine which commands to include when completing. +The predicate function is called with two parameter: The +symbol (i.e., command) in question that should be included or +not, and the current buffer. The predicate should return non-nil +if the command should be present when doing `M-x TAB'." + :version "28.1" + :type '(choice (const :tag "Exclude commands not relevant to this mode" + #'completion-in-mode-p) + (const :tag "All commands" (lambda (_ _) t)) + (function :tag "Other function"))) + (defun read-extended-command () - "Read command name to invoke in `execute-extended-command'." - (minibuffer-with-setup-hook - (lambda () - (add-hook 'post-self-insert-hook - (lambda () - (setq execute-extended-command--last-typed - (minibuffer-contents))) - nil 'local) - (setq-local minibuffer-default-add-function - (lambda () - ;; Get a command name at point in the original buffer - ;; to propose it after M-n. - (let ((def (with-current-buffer - (window-buffer (minibuffer-selected-window)) - (and (commandp (function-called-at-point)) - (format "%S" (function-called-at-point))))) - (all (sort (minibuffer-default-add-completions) - #'string<))) - (if def - (cons def (delete def all)) - all))))) - ;; Read a string, completing from and restricting to the set of - ;; all defined commands. Don't provide any initial input. - ;; Save the command read on the extended-command history list. - (completing-read - (concat (cond - ((eq current-prefix-arg '-) "- ") - ((and (consp current-prefix-arg) - (eq (car current-prefix-arg) 4)) "C-u ") - ((and (consp current-prefix-arg) - (integerp (car current-prefix-arg))) - (format "%d " (car current-prefix-arg))) - ((integerp current-prefix-arg) - (format "%d " current-prefix-arg))) - ;; This isn't strictly correct if `execute-extended-command' - ;; is bound to anything else (e.g. [menu]). - ;; It could use (key-description (this-single-command-keys)), - ;; but actually a prompt other than "M-x" would be confusing, - ;; because "M-x" is a well-known prompt to read a command - ;; and it serves as a shorthand for "Extended command: ". - "M-x ") - (lambda (string pred action) - (if (and suggest-key-bindings (eq action 'metadata)) - '(metadata - (affixation-function . read-extended-command--affixation) - (category . command)) - (complete-with-action action obarray string pred))) - #'commandp t nil 'extended-command-history))) + "Read command name to invoke in `execute-extended-command'. +This function uses the `read-extended-command-predicate' user option." + (let ((buffer (current-buffer))) + (minibuffer-with-setup-hook + (lambda () + (add-hook 'post-self-insert-hook + (lambda () + (setq execute-extended-command--last-typed + (minibuffer-contents))) + nil 'local) + (setq-local minibuffer-default-add-function + (lambda () + ;; Get a command name at point in the original buffer + ;; to propose it after M-n. + (let ((def + (with-current-buffer + (window-buffer (minibuffer-selected-window)) + (and (commandp (function-called-at-point)) + (format + "%S" (function-called-at-point))))) + (all (sort (minibuffer-default-add-completions) + #'string<))) + (if def + (cons def (delete def all)) + all))))) + ;; Read a string, completing from and restricting to the set of + ;; all defined commands. Don't provide any initial input. + ;; Save the command read on the extended-command history list. + (completing-read + (concat (cond + ((eq current-prefix-arg '-) "- ") + ((and (consp current-prefix-arg) + (eq (car current-prefix-arg) 4)) "C-u ") + ((and (consp current-prefix-arg) + (integerp (car current-prefix-arg))) + (format "%d " (car current-prefix-arg))) + ((integerp current-prefix-arg) + (format "%d " current-prefix-arg))) + ;; This isn't strictly correct if `execute-extended-command' + ;; is bound to anything else (e.g. [menu]). + ;; It could use (key-description (this-single-command-keys)), + ;; but actually a prompt other than "M-x" would be confusing, + ;; because "M-x" is a well-known prompt to read a command + ;; and it serves as a shorthand for "Extended command: ". + "M-x ") + (lambda (string pred action) + (if (and suggest-key-bindings (eq action 'metadata)) + '(metadata + (affixation-function . read-extended-command--affixation) + (category . command)) + (complete-with-action action obarray string pred))) + (lambda (sym) + (and (commandp sym) + (if (get sym 'completion-predicate) + (funcall (get sym 'completion-predicate) sym buffer) + (funcall read-extended-command-predicate sym buffer)))) + t nil 'extended-command-history)))) + +(defun completion-in-mode-p (symbol buffer) + "Say whether SYMBOL should be offered as a completion. +This is true if the command is applicable to the major mode in +BUFFER." + (or (null (command-modes symbol)) + ;; It's derived from a major mode. + (apply #'provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + (command-modes symbol)) + ;; It's a minor mode. + (seq-intersection (command-modes symbol) + (buffer-local-value 'minor-modes buffer) + #'eq))) (defun completion-with-modes-p (modes buffer) (apply #'provided-mode-derived-p From 8cdb61679e169a68829a3122d4eda7139199f7ee Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 13:57:59 +0100 Subject: [PATCH 185/297] Revert the bit about command_modes in previous patch set * src/data.c (Fcommand_modes): Remove the subr bit -- it's not necessary since it can just use a predicate. * src/lisp.h (GCALIGNED_STRUCT): Remove command_modes. * src/lread.c (defsubr): Remove command_modes. --- src/data.c | 7 +------ src/lisp.h | 1 - src/lread.c | 1 - 3 files changed, 1 insertion(+), 8 deletions(-) diff --git a/src/data.c b/src/data.c index 7bddc039f6f..ace859d2d0c 100644 --- a/src/data.c +++ b/src/data.c @@ -961,12 +961,7 @@ The value, if non-nil, is a list of mode name symbols. */) while (SYMBOLP (fun)) fun = Fsymbol_function (fun); - if (SUBRP (fun)) - { - if (!NILP (XSUBR (fun)->command_modes)) - return XSUBR (fun)->command_modes; - } - else if (COMPILEDP (fun)) + if (COMPILEDP (fun)) { Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); if (VECTORP (form)) diff --git a/src/lisp.h b/src/lisp.h index 697dd89363c..b95f389b890 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2060,7 +2060,6 @@ struct Lisp_Subr const char *symbol_name; const char *intspec; EMACS_INT doc; - Lisp_Object command_modes; } GCALIGNED_STRUCT; union Aligned_Lisp_Subr { diff --git a/src/lread.c b/src/lread.c index 8b8ba93c607..dea1b232fff 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4467,7 +4467,6 @@ defsubr (union Aligned_Lisp_Subr *aname) XSETPVECTYPE (sname, PVEC_SUBR); XSETSUBR (tem, sname); set_symbol_function (sym, tem); - sname->command_modes = Qnil; } #ifdef NOTDEF /* Use fset in subr.el now! */ From a4c8b6e7c6ccc0608fb555a1b063d3072e13e50a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 14:00:51 +0100 Subject: [PATCH 186/297] Fix dumping of buffers after minor_modes was added * src/pdumper.c (dump_buffer): Set minor_modes to nil before dumping. --- src/pdumper.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/pdumper.c b/src/pdumper.c index c1388ebbb37..b68f992c33a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2692,7 +2692,7 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_99D642C1CB +#if CHECK_STRUCTS && !defined HASH_buffer_732A01EB61 # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; @@ -2703,6 +2703,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) buffer->window_count = 0; else eassert (buffer->window_count == -1); + buffer->minor_modes_ = Qnil; buffer->last_selected_window_ = Qnil; buffer->display_count_ = make_fixnum (0); buffer->clip_changed = 0; From 40f7804ecb299a7f7c3accd19d27e2898d3b8374 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 14:06:16 +0100 Subject: [PATCH 187/297] Allow define-minor-mode to take an :interactive keyword * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Allow specifying the :interactive state and the modes. --- etc/NEWS | 8 +++++++- lisp/emacs-lisp/easy-mmode.el | 22 +++++++++++++++++----- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 9c3396d33af..22c320bfa31 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2294,7 +2294,13 @@ This permanently buffer-local variable holds a list of currently enabled minor modes in the current buffer (as a list of symbols). +++ -** 'defined-derived-mode' now takes an :interactive argument. +** 'define-minor-mode' now takes an :interactive argument. +This can be used for specifying which modes this minor mode is meant +for, or to make the new minor mode non-interactive. The default value +is t. + ++++ +** 'define-derived-mode' now takes an :interactive argument. This can be used to control whether the defined mode is a command or not, and is useful when defining commands that aren't meant to be used by users directly. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index bfffbe4bf20..08ac8186949 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -172,6 +172,10 @@ BODY contains code to execute each time the mode is enabled or disabled. :lighter SPEC Same as the LIGHTER argument. :keymap MAP Same as the KEYMAP argument. :require SYM Same as in `defcustom'. +:interactive VAL Whether this mode should be a command or not. The default + is to make it one; use nil to avoid that. If VAL is a list, + it's interpreted as a list of major modes this minor mode + is useful in. :variable PLACE The location to use instead of the variable MODE to store the state of the mode. This can be simply a different named variable, or a generalized variable. @@ -226,6 +230,7 @@ For example, you could write (hook (intern (concat mode-name "-hook"))) (hook-on (intern (concat mode-name "-on-hook"))) (hook-off (intern (concat mode-name "-off-hook"))) + (interactive t) keyw keymap-sym tmp) ;; Check keys. @@ -245,6 +250,7 @@ For example, you could write (:type (setq type (list :type (pop body)))) (:require (setq require (pop body))) (:keymap (setq keymap (pop body))) + (:interactive (setq interactive (pop body))) (:variable (setq variable (pop body)) (if (not (and (setq tmp (cdr-safe variable)) (or (symbolp tmp) @@ -303,11 +309,17 @@ or call the function `%s'.")))) ;; The actual function. (defun ,modefun (&optional arg ,@extra-args) ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) - ;; Use `toggle' rather than (if ,mode 0 1) so that using - ;; repeat-command still does the toggling correctly. - (interactive (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 'toggle))) + ,(when interactive + ;; Use `toggle' rather than (if ,mode 0 1) so that using + ;; repeat-command still does the toggling correctly. + (if (consp interactive) + `(command ,interactive + (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle))) + '(interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle))))) (let ((,last-message (current-message))) (,@setter (cond ((eq arg 'toggle) From 98e3ee27472d071c353743dcfc0eaef7c2f21059 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 14:07:48 +0100 Subject: [PATCH 188/297] Make `C-h m' list unbound commands applicable for the mode * lisp/help-fns.el (help-fns--list-local-commands): New function. (describe-mode): Use it. --- lisp/help-fns.el | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index b03a4404129..0e2c68292c6 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1827,9 +1827,30 @@ documentation for the major and minor modes of that buffer." nil t) (help-xref-button 1 'help-function-def mode file-name))))) (princ ":\n") - (princ (help-split-fundoc (documentation major-mode) nil 'doc))))) + (princ (help-split-fundoc (documentation major-mode) nil 'doc)) + (princ (help-fns--list-local-commands))))) ;; For the sake of IELM and maybe others nil) + +(defun help-fns--list-local-commands () + (let ((functions nil)) + (mapatoms + (lambda (sym) + (when (and (commandp sym) + ;; Ignore aliases. + (not (symbolp (symbol-function sym))) + ;; Ignore everything bound. + (not (where-is-internal sym)) + (apply #'derived-mode-p (command-modes sym))) + (push sym functions)))) + (with-temp-buffer + (when functions + (setq functions (sort functions #'string<)) + (insert "\n\nOther commands for this mode, not bound to any keys:\n\n") + (dolist (function functions) + (insert (format "`%s'\n" function)))) + (buffer-string)))) + ;; Widgets. From ffca27267822f019a0b0dc86101ef54234839e05 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 14:08:56 +0100 Subject: [PATCH 189/297] Mark up eww.el for correct modes * lisp/net/eww.el: Mark up all commands with applicable modes. --- lisp/net/eww.el | 78 +++++++++++++++++++++++++++---------------------- 1 file changed, 43 insertions(+), 35 deletions(-) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index e39a4c33b20..c94fa03a071 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -855,7 +855,7 @@ Currently this means either text/html or application/xhtml+xml." (defun eww-view-source () "View the HTML source code of the current page." - (interactive) + (interactive nil eww-mode) (let ((buf (get-buffer-create "*eww-source*")) (source (plist-get eww-data :source))) (with-current-buffer buf @@ -881,7 +881,7 @@ Currently this means either text/html or application/xhtml+xml." (defun eww-toggle-paragraph-direction () "Cycle the paragraph direction between left-to-right, right-to-left and auto." - (interactive) + (interactive nil eww-mode) (setq bidi-paragraph-direction (cond ((eq bidi-paragraph-direction 'left-to-right) nil) @@ -899,7 +899,7 @@ Currently this means either text/html or application/xhtml+xml." This command uses heuristics to find the parts of the web page that contains the main textual portion, leaving out navigation menus and the like." - (interactive) + (interactive nil eww-mode) (let* ((old-data eww-data) (dom (with-temp-buffer (insert (plist-get old-data :source)) @@ -1038,6 +1038,7 @@ the like." ;;;###autoload (define-derived-mode eww-mode special-mode "eww" "Mode for browsing the web." + :interactive nil (setq-local eww-data (list :title "")) (setq-local browse-url-browser-function #'eww-browse-url) (add-hook 'after-change-functions #'eww-process-text-input nil t) @@ -1090,7 +1091,7 @@ instead of `browse-url-new-window-flag'." (defun eww-back-url () "Go to the previously displayed page." - (interactive) + (interactive nil eww-mode) (when (>= eww-history-position (length eww-history)) (user-error "No previous page")) (eww-save-history) @@ -1099,7 +1100,7 @@ instead of `browse-url-new-window-flag'." (defun eww-forward-url () "Go to the next displayed page." - (interactive) + (interactive nil eww-mode) (when (zerop eww-history-position) (user-error "No next page")) (eww-save-history) @@ -1123,7 +1124,7 @@ instead of `browse-url-new-window-flag'." "Go to the page marked `next'. A page is marked `next' if rel=\"next\" appears in a or tag." - (interactive) + (interactive nil eww-mode) (if (plist-get eww-data :next) (eww-browse-url (shr-expand-url (plist-get eww-data :next) (plist-get eww-data :url))) @@ -1133,7 +1134,7 @@ or tag." "Go to the page marked `previous'. A page is marked `previous' if rel=\"previous\" appears in a or tag." - (interactive) + (interactive nil eww-mode) (if (plist-get eww-data :previous) (eww-browse-url (shr-expand-url (plist-get eww-data :previous) (plist-get eww-data :url))) @@ -1143,7 +1144,7 @@ or tag." "Go to the page marked `up'. A page is marked `up' if rel=\"up\" appears in a or tag." - (interactive) + (interactive nil eww-mode) (if (plist-get eww-data :up) (eww-browse-url (shr-expand-url (plist-get eww-data :up) (plist-get eww-data :url))) @@ -1153,7 +1154,7 @@ or tag." "Go to the page marked `top'. A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\" appears in a or tag." - (interactive) + (interactive nil eww-mode) (let ((best-url (or (plist-get eww-data :start) (plist-get eww-data :contents) (plist-get eww-data :home)))) @@ -1166,7 +1167,7 @@ appears in a or tag." If LOCAL is non-nil (interactively, the command was invoked with a prefix argument), don't reload the page from the network, but just re-display the HTML already fetched." - (interactive "P") + (interactive "P" eww-mode) (let ((url (plist-get eww-data :url))) (if local (if (null (plist-get eww-data :dom)) @@ -1232,12 +1233,12 @@ just re-display the HTML already fetched." (defun eww-beginning-of-text () "Move to the start of the input field." - (interactive) + (interactive nil eww-mode) (goto-char (eww-beginning-of-field))) (defun eww-end-of-text () "Move to the end of the text in the input field." - (interactive) + (interactive nil eww-mode) (goto-char (eww-end-of-field)) (let ((start (eww-beginning-of-field))) (while (and (equal (following-char) ? ) @@ -1329,7 +1330,7 @@ just re-display the HTML already fetched." (defun eww-select-file () "Change the value of the upload file menu under point." - (interactive) + (interactive nil eww-mode) (let* ((input (get-text-property (point) 'eww-form))) (let ((filename (let ((insert-default-directory t)) @@ -1537,7 +1538,9 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (defun eww-change-select (event) "Change the value of the select drop-down menu under point." - (interactive (list last-nonmenu-event)) + (interactive + (list last-nonmenu-event) + eww-mode) (mouse-set-point event) (let ((input (get-text-property (point) 'eww-form))) (popup-menu @@ -1572,7 +1575,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (defun eww-toggle-checkbox () "Toggle the value of the checkbox under point." - (interactive) + (interactive nil eww-mode) (let* ((input (get-text-property (point) 'eww-form)) (type (plist-get input :type))) (if (equal type "checkbox") @@ -1642,7 +1645,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (defun eww-submit () "Submit the current form." - (interactive) + (interactive nil eww-mode) (let* ((this-input (get-text-property (point) 'eww-form)) (form (plist-get this-input :eww-form)) values next-submit) @@ -1729,7 +1732,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") "Browse the current URL with an external browser. The browser to used is specified by the `browse-url-secondary-browser-function' variable." - (interactive) + (interactive nil eww-mode) (funcall browse-url-secondary-browser-function (or url (plist-get eww-data :url)))) @@ -1739,7 +1742,9 @@ If EXTERNAL is single prefix, browse the URL using `browse-url-secondary-browser-function'. If EXTERNAL is double prefix, browse in new buffer." - (interactive (list current-prefix-arg last-nonmenu-event)) + (interactive + (list current-prefix-arg last-nonmenu-event) + eww-mode) (mouse-set-point mouse-event) (let ((url (get-text-property (point) 'shr-url))) (cond @@ -1773,14 +1778,14 @@ Differences in #targets are ignored." (defun eww-copy-page-url () "Copy the URL of the current page into the kill ring." - (interactive) + (interactive nil eww-mode) (message "%s" (plist-get eww-data :url)) (kill-new (plist-get eww-data :url))) (defun eww-download () "Download URL to `eww-download-directory'. Use link at point if there is one, else the current page's URL." - (interactive) + (interactive nil eww-mode) (let ((dir (if (stringp eww-download-directory) eww-download-directory (funcall eww-download-directory)))) @@ -1848,14 +1853,14 @@ Use link at point if there is one, else the current page's URL." (defun eww-set-character-encoding (charset) "Set character encoding to CHARSET. If CHARSET is nil then use UTF-8." - (interactive "zUse character set (default utf-8): ") + (interactive "zUse character set (default utf-8): " eww-mode) (if (null charset) (eww-reload nil 'utf-8) (eww-reload nil charset))) (defun eww-switch-to-buffer () "Prompt for an EWW buffer to display in the selected window." - (interactive) + (interactive nil eww-mode) (let ((completion-extra-properties '(:annotation-function (lambda (buf) (with-current-buffer buf @@ -1873,7 +1878,7 @@ If CHARSET is nil then use UTF-8." (defun eww-toggle-fonts () "Toggle whether to use monospaced or font-enabled layouts." - (interactive) + (interactive nil eww-mode) (setq shr-use-fonts (not shr-use-fonts)) (eww-reload) (message "Proportional fonts are now %s" @@ -1881,7 +1886,7 @@ If CHARSET is nil then use UTF-8." (defun eww-toggle-colors () "Toggle whether to use HTML-specified colors or not." - (interactive) + (interactive nil eww-mode) (message "Colors are now %s" (if (setq shr-use-colors (not shr-use-colors)) "on" @@ -1894,7 +1899,7 @@ If CHARSET is nil then use UTF-8." (defun eww-add-bookmark () "Bookmark the current page." - (interactive) + (interactive nil eww-mode) (eww-read-bookmarks) (dolist (bookmark eww-bookmarks) (when (equal (plist-get eww-data :url) (plist-get bookmark :url)) @@ -1958,7 +1963,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-bookmark-kill () "Kill the current bookmark." - (interactive) + (interactive nil eww-bookmark-mode) (let* ((start (line-beginning-position)) (bookmark (get-text-property start 'eww-bookmark)) (inhibit-read-only t)) @@ -1972,7 +1977,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-bookmark-yank () "Yank a previously killed bookmark to the current line." - (interactive) + (interactive nil eww-bookmark-mode) (unless eww-bookmark-kill-ring (user-error "No previously killed bookmark")) (beginning-of-line) @@ -1990,7 +1995,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-bookmark-browse () "Browse the bookmark under point in eww." - (interactive) + (interactive nil eww-bookmark-mode) (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark))) (unless bookmark (user-error "No bookmark on the current line")) @@ -1999,7 +2004,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-next-bookmark () "Go to the next bookmark in the list." - (interactive) + (interactive nil eww-bookmark-mode) (let ((first nil) bookmark) (unless (get-buffer "*eww bookmarks*") @@ -2018,7 +2023,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-previous-bookmark () "Go to the previous bookmark in the list." - (interactive) + (interactive nil eww-bookmark-mode) (let ((first nil) bookmark) (unless (get-buffer "*eww bookmarks*") @@ -2061,6 +2066,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." "Mode for listing bookmarks. \\{eww-bookmark-mode-map}" + :interactive nil (buffer-disable-undo) (setq truncate-lines t)) @@ -2109,7 +2115,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-history-browse () "Browse the history under point in eww." - (interactive) + (interactive nil eww-history-mode) (let ((history (get-text-property (line-beginning-position) 'eww-history))) (unless history (error "No history on the current line")) @@ -2137,6 +2143,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." "Mode for listing eww-histories. \\{eww-history-mode-map}" + :interactive nil (buffer-disable-undo) (setq truncate-lines t)) @@ -2191,7 +2198,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-buffer-select () "Switch to eww buffer." - (interactive) + (interactive nil eww-buffers-mode) (let ((buffer (get-text-property (line-beginning-position) 'eww-buffer))) (unless buffer @@ -2211,7 +2218,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-buffer-show-next () "Move to next eww buffer in the list and display it." - (interactive) + (interactive nil eww-buffers-mode) (forward-line) (when (eobp) (goto-char (point-min))) @@ -2219,7 +2226,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-buffer-show-previous () "Move to previous eww buffer in the list and display it." - (interactive) + (interactive nil eww-buffers-mode) (beginning-of-line) (when (bobp) (goto-char (point-max))) @@ -2228,7 +2235,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (defun eww-buffer-kill () "Kill buffer from eww list." - (interactive) + (interactive nil eww-buffers-mode) (let* ((start (line-beginning-position)) (buffer (get-text-property start 'eww-buffer)) (inhibit-read-only t)) @@ -2262,6 +2269,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." "Mode for listing buffers. \\{eww-buffers-mode-map}" + :interactive nil (buffer-disable-undo) (setq truncate-lines t)) From 07e6b29b12c961808fcf4d8f804946056118efc5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 14:12:08 +0100 Subject: [PATCH 190/297] Fix previous define-minor-mode change * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Fix interactive extension in previous change. --- lisp/emacs-lisp/easy-mmode.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 08ac8186949..01fb58e863a 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -313,10 +313,11 @@ or call the function `%s'.")))) ;; Use `toggle' rather than (if ,mode 0 1) so that using ;; repeat-command still does the toggling correctly. (if (consp interactive) - `(command ,interactive - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 'toggle))) + `(interactive + ,interactive + (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle))) '(interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) 'toggle))))) From 869cdcf4e7a787534d275ca6fc0a792ab642c764 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 14:13:38 +0100 Subject: [PATCH 191/297] Really fix the syntax problem in define-minor-mode * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Fix interactive extension in previous change. --- lisp/emacs-lisp/easy-mmode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 01fb58e863a..7e5e2a9b8a9 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -314,10 +314,10 @@ or call the function `%s'.")))) ;; repeat-command still does the toggling correctly. (if (consp interactive) `(interactive - ,interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) - 'toggle))) + 'toggle)) + ,@interactive) '(interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) 'toggle))))) From c0221990c46a89b6ecbc8c831225785405aa82b7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 14:14:48 +0100 Subject: [PATCH 192/297] Do `interactive' mode markup in all Gnus files --- lisp/gnus/deuglify.el | 10 +- lisp/gnus/gnus-art.el | 276 +++++++++-------- lisp/gnus/gnus-bookmark.el | 24 +- lisp/gnus/gnus-cache.el | 8 +- lisp/gnus/gnus-cite.el | 12 +- lisp/gnus/gnus-cus.el | 9 +- lisp/gnus/gnus-delay.el | 8 +- lisp/gnus/gnus-diary.el | 4 +- lisp/gnus/gnus-dired.el | 9 +- lisp/gnus/gnus-draft.el | 6 +- lisp/gnus/gnus-eform.el | 4 +- lisp/gnus/gnus-fun.el | 19 +- lisp/gnus/gnus-gravatar.el | 4 +- lisp/gnus/gnus-group.el | 276 +++++++++-------- lisp/gnus/gnus-icalendar.el | 14 +- lisp/gnus/gnus-int.el | 2 +- lisp/gnus/gnus-mh.el | 2 +- lisp/gnus/gnus-msg.el | 85 +++--- lisp/gnus/gnus-picon.el | 8 +- lisp/gnus/gnus-registry.el | 11 +- lisp/gnus/gnus-salt.el | 10 +- lisp/gnus/gnus-score.el | 51 ++-- lisp/gnus/gnus-sieve.el | 2 +- lisp/gnus/gnus-srvr.el | 68 +++-- lisp/gnus/gnus-start.el | 4 +- lisp/gnus/gnus-sum.el | 586 +++++++++++++++++++----------------- lisp/gnus/gnus-topic.el | 101 ++++--- lisp/gnus/gnus-uu.el | 99 +++--- lisp/gnus/gnus-vm.el | 4 +- lisp/gnus/gnus.el | 44 +-- 30 files changed, 932 insertions(+), 828 deletions(-) diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index 08beef7db9f..e6c4630a67b 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -310,7 +310,7 @@ You can control what lines will be unwrapped by frobbing `gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max', indicating the minimum and maximum length of an unwrapped citation line. If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((case-fold-search nil) (inhibit-read-only t) (cite-marks gnus-outlook-deuglify-cite-marks) @@ -430,7 +430,7 @@ NODISPLAY is non-nil, don't redisplay the article buffer." (defun gnus-article-outlook-repair-attribution (&optional nodisplay) "Repair a broken attribution line. If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((attrib-start (or (gnus-outlook-repair-attribution-other) @@ -442,7 +442,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer." (defun gnus-article-outlook-rearrange-citation (&optional nodisplay) "Repair broken citations. If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((attrib-start (gnus-article-outlook-repair-attribution 'nodisplay))) ;; rearrange citations if an attribution line has been recognized (if attrib-start @@ -455,7 +455,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer." Treat \"smartquotes\", unwrap lines, repair attribution and rearrange citation. If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) ;; apply treatment of dumb quotes (gnus-article-treat-smartquotes) ;; repair wrapped cited lines @@ -467,7 +467,7 @@ article buffer." ;;;###autoload (defun gnus-article-outlook-deuglify-article () "Deuglify broken Outlook (Express) articles and redisplay." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-outlook-deuglify-article nil)) (provide 'deuglify) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c9afa3ac948..435ccab7403 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1823,7 +1823,7 @@ Initialized from `text-mode-syntax-table'.") (defun article-hide-headers (&optional _arg _delete) "Hide unwanted headers and possibly sort them as well." - (interactive) + (interactive nil gnus-article-mode) ;; This function might be inhibited. (unless gnus-inhibit-hiding (let ((inhibit-read-only t) @@ -1891,7 +1891,7 @@ Initialized from `text-mode-syntax-table'.") "Toggle hiding of headers that aren't very interesting. If given a negative prefix, always show; if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) + (interactive (gnus-article-hidden-arg) gnus-article-mode) (when (and (not (gnus-article-check-hidden-text 'boring-headers arg)) (not gnus-show-all-headers)) (save-excursion @@ -2050,7 +2050,7 @@ always hide." (defun article-normalize-headers () "Make all header lines 40 characters long." - (interactive) + (interactive nil gnus-article-mode) (let ((inhibit-read-only t) column) (save-excursion @@ -2086,7 +2086,7 @@ iso-8859-1 character map in an attempt to provide more quoting characters. If you see something like \\222 or \\264 where you're expecting some kind of apostrophe or quotation mark, then try this wash." - (interactive) + (interactive nil gnus-article-mode) (article-translate-strings gnus-article-smartquotes-map)) (define-obsolete-function-alias 'article-treat-dumbquotes #'article-treat-smartquotes "27.1") @@ -2095,7 +2095,7 @@ try this wash." (defun article-treat-non-ascii () "Translate many Unicode characters into their ASCII equivalents." - (interactive) + (interactive nil gnus-article-mode) (require 'org-entities) (let ((table (make-char-table nil))) (dolist (elem org-entities) @@ -2138,7 +2138,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (defun article-treat-overstrike () "Translate overstrikes into bold text." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (when (article-goto-body) (let ((inhibit-read-only t)) @@ -2166,7 +2166,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (defun article-treat-ansi-sequences () "Translate ANSI SGR control sequences into overlays or extents." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (when (article-goto-body) (require 'ansi-color) @@ -2178,7 +2178,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." "Unfold folded message headers. Only the headers that fit into the current window width will be unfolded." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (let (length) (while (not (eobp)) @@ -2204,7 +2204,7 @@ unfolded." (defun gnus-article-treat-fold-headers () "Fold message headers." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (while (not (eobp)) (save-restriction @@ -2214,7 +2214,7 @@ unfolded." (defun gnus-treat-smiley () "Toggle display of textual emoticons (\"smileys\") as small graphical icons." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (if (memq 'smiley gnus-article-wash-types) (gnus-delete-images 'smiley) @@ -2227,7 +2227,7 @@ unfolded." (defun gnus-article-remove-images () "Remove all images from the article buffer." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (save-restriction (widen) @@ -2239,7 +2239,7 @@ unfolded." (defun gnus-article-show-images () "Show any images that are in the HTML-rendered article buffer. This only works if the article in question is HTML." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (save-restriction (widen) @@ -2255,7 +2255,7 @@ This only works if the article in question is HTML." (defun gnus-article-treat-fold-newsgroups () "Fold the Newsgroups and Followup-To message headers." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (while (gnus-article-goto-header "newsgroups\\|followup-to") (save-restriction @@ -2279,7 +2279,7 @@ predicate. See Info node `(gnus)Customizing Articles'." If ARG is non-nil and not a number, toggle `gnus-article-truncate-lines' too. If ARG is a number, truncate long lines if and only if arg is positive." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (cond ((and (numberp arg) (> arg 0)) (setq gnus-article-truncate-lines t)) @@ -2298,7 +2298,7 @@ long lines if and only if arg is positive." (defun gnus-article-treat-body-boundary () "Place a boundary line at the end of the headers." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (when (and gnus-body-boundary-delimiter (> (length gnus-body-boundary-delimiter) 0)) (gnus-with-article-headers @@ -2317,7 +2317,7 @@ long lines if and only if arg is positive." "Fill lines that are wider than the window width or `fill-column'. If WIDTH (interactively, the numeric prefix), use that as the fill width." - (interactive "P") + (interactive "P" gnus-article-mode) (save-excursion (let* ((inhibit-read-only t) (window-width (window-width (get-buffer-window (current-buffer)))) @@ -2341,7 +2341,7 @@ fill width." (defun article-capitalize-sentences () "Capitalize the first word in each sentence." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-read-only t) (paragraph-start "^[\n\^L]")) @@ -2352,7 +2352,7 @@ fill width." (defun article-remove-cr () "Remove trailing CRs and then translate remaining CRs into LFs." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-read-only t)) (goto-char (point-min)) @@ -2364,7 +2364,7 @@ fill width." (defun article-remove-trailing-blank-lines () "Remove all trailing blank lines from the article." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-read-only t)) (goto-char (point-max)) @@ -2383,7 +2383,7 @@ fill width." (defun article-display-face (&optional force) "Display any Face headers in the header." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode gnus-summary-mode) (let ((wash-face-p buffer-read-only)) (gnus-with-article-headers ;; When displaying parts, this function can be called several times on @@ -2431,7 +2431,7 @@ fill width." (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode gnus-summary-mode) (let ((wash-face-p buffer-read-only)) ;; When type `W f' (gnus-with-article-headers ;; Delete the old process, if any. @@ -2493,7 +2493,7 @@ fill width." (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t) (mail-parse-charset gnus-newsgroup-charset) @@ -2505,7 +2505,7 @@ fill width." (defun article-decode-charset (&optional prompt) "Decode charset-encoded text in the article. If PROMPT (the prefix), prompt for a coding system to use." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((inhibit-point-motion-hooks t) (case-fold-search t) (inhibit-read-only t) (mail-parse-charset gnus-newsgroup-charset) @@ -2627,7 +2627,7 @@ Mail-Reply-To: and Mail-Followup-To:." If FORCE, decode the article whether it is marked as quoted-printable or not. If READ-CHARSET, ask for a coding system." - (interactive (list 'force current-prefix-arg)) + (interactive (list 'force current-prefix-arg) gnus-article-mode) (save-excursion (let ((inhibit-read-only t) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) @@ -2655,7 +2655,7 @@ If READ-CHARSET, ask for a coding system." "Translate a base64 article. If FORCE, decode the article whether it is marked as base64 not. If READ-CHARSET, ask for a coding system." - (interactive (list 'force current-prefix-arg)) + (interactive (list 'force current-prefix-arg) gnus-article-mode) (save-excursion (let ((inhibit-read-only t) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) @@ -2687,7 +2687,7 @@ If READ-CHARSET, ask for a coding system." (defun article-decode-HZ () "Translate a HZ-encoded article." - (interactive) + (interactive nil gnus-article-mode) (require 'rfc1843) (save-excursion (let ((inhibit-read-only t)) @@ -2695,7 +2695,7 @@ If READ-CHARSET, ask for a coding system." (defun article-unsplit-urls () "Remove the newlines that some other mailers insert into URLs." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-read-only t)) (goto-char (point-min)) @@ -2707,7 +2707,7 @@ If READ-CHARSET, ask for a coding system." (defun article-wash-html () "Format an HTML article." - (interactive) + (interactive nil gnus-article-mode) (let ((handles nil) (inhibit-read-only t)) (when (gnus-buffer-live-p gnus-original-article-buffer) @@ -3041,7 +3041,7 @@ This command creates temporary files to pass HTML contents including images if any to the browser, and deletes them when exiting the group \(if you want)." ;; Cf. `mm-w3m-safe-url-regexp' - (interactive "P") + (interactive "P" gnus-article-mode) (if arg (gnus-summary-show-article) (let ((gnus-visible-headers @@ -3078,7 +3078,7 @@ images if any to the browser, and deletes them when exiting the group (defun article-hide-list-identifiers () "Remove list identifiers from the Subject header. The `gnus-list-identifiers' variable specifies what to do." - (interactive) + (interactive nil gnus-article-mode) (let ((inhibit-point-motion-hooks t) (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) (inhibit-read-only t)) @@ -3100,7 +3100,7 @@ The `gnus-list-identifiers' variable specifies what to do." "Toggle hiding of any PEM headers and signatures in the current article. If given a negative prefix, always show; if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) + (interactive (gnus-article-hidden-arg) gnus-article-mode) (unless (gnus-article-check-hidden-text 'pem arg) (save-excursion (let ((inhibit-read-only t) end) @@ -3126,7 +3126,7 @@ always hide." (defun article-strip-banner () "Strip the banners specified by the `banner' group parameter and by `gnus-article-address-banner-alist'." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (save-restriction (let ((inhibit-point-motion-hooks t)) @@ -3175,7 +3175,7 @@ always hide." (defun article-babel () "Translate article using an online translation service." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (require 'babel) (gnus-with-article-buffer (when (article-goto-body) @@ -3192,7 +3192,7 @@ always hide." "Hide the signature in the current article. If given a negative prefix, always show; if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) + (interactive (gnus-article-hidden-arg) gnus-article-mode) (unless (gnus-article-check-hidden-text 'signature arg) (save-excursion (save-restriction @@ -3204,7 +3204,7 @@ always hide." (defun article-strip-headers-in-body () "Strip offensive headers from bodies." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (article-goto-body) (let ((case-fold-search t)) @@ -3213,7 +3213,7 @@ always hide." (defun article-strip-leading-blank-lines () "Remove all blank lines from the beginning of the article." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3255,7 +3255,7 @@ Point is left at the beginning of the narrowed-to region." (defun article-strip-multiple-blank-lines () "Replace consecutive blank lines with one empty line." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3274,7 +3274,7 @@ Point is left at the beginning of the narrowed-to region." (defun article-strip-leading-space () "Remove all white space from the beginning of the lines in the article." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3284,7 +3284,7 @@ Point is left at the beginning of the narrowed-to region." (defun article-strip-trailing-space () "Remove all white space from the end of the lines in the article." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3294,14 +3294,14 @@ Point is left at the beginning of the narrowed-to region." (defun article-strip-blank-lines () "Strip leading, trailing and multiple blank lines." - (interactive) + (interactive nil gnus-article-mode) (article-strip-leading-blank-lines) (article-remove-trailing-blank-lines) (article-strip-multiple-blank-lines)) (defun article-strip-all-blank-lines () "Strip all blank lines." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3433,7 +3433,7 @@ lines forward." "Convert DATE date to TYPE in the current article. The default type is `ut'. See `gnus-article-date-headers' for possible values." - (interactive (list 'ut t)) + (interactive (list 'ut t) gnus-article-mode) (let* ((case-fold-search t) (inhibit-read-only t) (inhibit-point-motion-hooks t) @@ -3677,29 +3677,29 @@ possible values." (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'local highlight)) (defun article-date-english (&optional highlight) "Convert the current article date to something that is proper English." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'english highlight)) (defun article-date-original (&optional highlight) "Convert the current article date to what it was originally. This is only useful if you have used some other date conversion function and want to see what the date was before converting." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'original highlight)) (defun article-date-lapsed (&optional highlight) "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'lapsed highlight)) (defun article-date-combined-lapsed (&optional highlight) "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'combined-lapsed highlight)) (defun article-update-date-lapsed () @@ -3748,7 +3748,7 @@ function and want to see what the date was before converting." "Start a timer to update the Date headers in the article buffers. The numerical prefix says how frequently (in seconds) the function is to run." - (interactive "p") + (interactive "p" gnus-article-mode) (unless n (setq n 1)) (gnus-stop-date-timer) @@ -3757,7 +3757,7 @@ is to run." (defun gnus-stop-date-timer () "Stop the Date timer." - (interactive) + (interactive nil gnus-article-mode) (when article-lapsed-timer (cancel-timer article-lapsed-timer) (setq article-lapsed-timer nil))) @@ -3765,12 +3765,12 @@ is to run." (defun article-date-user (&optional highlight) "Convert the current article date to the user-defined format. This format is defined by the `gnus-article-time-format' variable." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'user-defined highlight)) (defun article-date-iso8601 (&optional highlight) "Convert the current article date to ISO8601." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'iso8601 highlight)) (defmacro gnus-article-save-original-date (&rest forms) @@ -3803,7 +3803,7 @@ This format is defined by the `gnus-article-time-format' variable." (defun article-remove-leading-whitespace () "Remove excessive whitespace from all headers." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (save-restriction (let ((inhibit-read-only t)) @@ -3814,7 +3814,7 @@ This format is defined by the `gnus-article-time-format' variable." (defun article-emphasize (&optional arg) "Emphasize text according to `gnus-emphasis-alist'." - (interactive (gnus-article-hidden-arg)) + (interactive (gnus-article-hidden-arg) gnus-article-mode) (unless (gnus-article-check-hidden-text 'emphasis arg) (save-excursion (let ((alist (or @@ -4247,7 +4247,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defun article-verify-x-pgp-sig () "Verify X-PGP-Sig." ;; - (interactive) + (interactive nil gnus-article-mode) (if (gnus-buffer-live-p gnus-original-article-buffer) (let ((sig (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "X-PGP-Sig"))) @@ -4321,7 +4321,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defun article-verify-cancel-lock () "Verify Cancel-Lock header." - (interactive) + (interactive nil gnus-article-mode) (if (gnus-buffer-live-p gnus-original-article-buffer) (canlock-verify gnus-original-article-buffer))) @@ -4330,7 +4330,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is `(defun ,(intern (format "gnus-%s" func)) (&optional interactive &rest args) ,(format "Run `%s' in the article buffer." func) - (interactive (list t)) + (interactive (list t) gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (if interactive (call-interactively #',func) @@ -4752,7 +4752,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-sticky-article (arg) "Make the current article sticky. If a prefix ARG is given, ask for a name for this sticky article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-summary-show-thread) (gnus-summary-select-article nil nil 'pseudo) (let (new-art-buf-name) @@ -4796,7 +4796,7 @@ If a prefix ARG is given, ask for a name for this sticky article buffer." "Kill the given sticky article BUFFER. If none is given, assume the current buffer and kill it if it has `gnus-sticky-article-mode'." - (interactive) + (interactive nil gnus-article-mode) (unless buffer (setq buffer (current-buffer))) (with-current-buffer buffer @@ -4806,7 +4806,7 @@ If none is given, assume the current buffer and kill it if it has (defun gnus-kill-sticky-article-buffers (arg) "Kill all sticky article buffers. If a prefix ARG is given, ask for confirmation." - (interactive "P") + (interactive "P" gnus-article-mode) (dolist (buf (gnus-buffers)) (with-current-buffer buf (and (derived-mode-p 'gnus-sticky-article-mode) @@ -4948,7 +4948,7 @@ General format specifiers can also be used. See Info node (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." - (interactive) + (interactive nil gnus-article-mode) (with-current-buffer gnus-article-buffer (let ((handles (or handles gnus-article-mime-handles)) (mail-parse-charset gnus-newsgroup-charset) @@ -4965,7 +4965,7 @@ General format specifiers can also be used. See Info node (defun gnus-article-jump-to-part (n) "Jump to MIME part N." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((parts (with-current-buffer gnus-article-buffer (length gnus-article-mime-handle-alist)))) (when (zerop parts) @@ -5061,11 +5061,11 @@ and `gnus-mime-delete-part', and not provided at run-time normally." (defun gnus-mime-replace-part (file) "Replace MIME part under point with an external body." ;; Useful if file has already been saved to disk - (interactive - (list - (read-file-name "Replace MIME part with file: " - (or mm-default-directory default-directory) - nil t))) + (interactive (list + (read-file-name "Replace MIME part with file: " + (or mm-default-directory default-directory) + nil t)) + gnus-article-mode) (unless (file-regular-p (file-truename file)) (error "Can't replace part with %s, which isn't a regular file" file)) @@ -5074,7 +5074,7 @@ and `gnus-mime-delete-part', and not provided at run-time normally." (defun gnus-mime-save-part-and-strip (&optional file event) "Save the MIME part under point then replace it with an external body. If FILE is given, use it for the external part." - (interactive (list nil last-nonmenu-event)) + (interactive (list nil last-nonmenu-event) gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5116,7 +5116,7 @@ The current article has a complicated MIME structure, giving up...")) (defun gnus-mime-delete-part (&optional event) "Delete the MIME part under point. Replace it with some information about the removed part." - (interactive (list last-nonmenu-event)) + (interactive (list last-nonmenu-event) gnus-article-mode) (mouse-set-point event) (gnus-article-check-buffer) (when (gnus-group-read-only-p) @@ -5165,7 +5165,7 @@ Deleting parts may malfunction or destroy the article; continue? ")) (defun gnus-mime-save-part (&optional event) "Save the MIME part under point." - (interactive (list last-nonmenu-event)) + (interactive (list last-nonmenu-event) gnus-article-mode) (mouse-set-point event) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) @@ -5175,7 +5175,7 @@ Deleting parts may malfunction or destroy the article; continue? ")) (defun gnus-mime-pipe-part (&optional cmd event) "Pipe the MIME part under point to a process. Use CMD as the process." - (interactive (list nil last-nonmenu-event)) + (interactive (list nil last-nonmenu-event) gnus-article-mode) (mouse-set-point event) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) @@ -5184,7 +5184,7 @@ Use CMD as the process." (defun gnus-mime-view-part (&optional event) "Interactively choose a viewing method for the MIME part under point." - (interactive (list last-nonmenu-event)) + (interactive (list last-nonmenu-event) gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5214,7 +5214,7 @@ Use CMD as the process." "Choose a MIME media type, and view the part as such. If non-nil, PRED is a predicate to use during completion to limit the available media-types." - (interactive (list nil nil last-nonmenu-event)) + (interactive (list nil nil last-nonmenu-event) gnus-article-mode) (save-excursion (if event (mouse-set-point event)) (unless mime-type @@ -5253,7 +5253,8 @@ available media-types." "Put the MIME part under point into a new buffer. If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 are decompressed." - (interactive (list nil current-prefix-arg last-nonmenu-event)) + (interactive (list nil current-prefix-arg last-nonmenu-event) + gnus-article-mode) (mouse-set-point event) (gnus-article-check-buffer) (unless handle @@ -5309,7 +5310,8 @@ are decompressed." (defun gnus-mime-print-part (&optional handle filename event) "Print the MIME part under point." (interactive - (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event)) + (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event) + gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5337,7 +5339,8 @@ are decompressed." (defun gnus-mime-inline-part (&optional handle arg event) "Insert the MIME part under point into the current buffer. Compressed files like .gz and .bz2 are decompressed." - (interactive (list nil current-prefix-arg last-nonmenu-event)) + (interactive (list nil current-prefix-arg last-nonmenu-event) + gnus-article-mode) (if event (mouse-set-point event)) (gnus-article-check-buffer) (let* ((inhibit-read-only t) @@ -5435,7 +5438,8 @@ CHARSET may either be a string or a symbol." (defun gnus-mime-view-part-as-charset (&optional handle arg event) "Insert the MIME part under point into the current buffer using the specified charset." - (interactive (list nil current-prefix-arg last-nonmenu-event)) + (interactive (list nil current-prefix-arg last-nonmenu-event) + gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5475,7 +5479,7 @@ specified charset." (defun gnus-mime-view-part-externally (&optional handle event) "View the MIME part under point with an external viewer." - (interactive (list nil last-nonmenu-event)) + (interactive (list nil last-nonmenu-event) gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5497,7 +5501,7 @@ specified charset." (defun gnus-mime-view-part-internally (&optional handle event) "View the MIME part under point with an internal viewer. If no internal viewer is available, use an external viewer." - (interactive (list nil last-nonmenu-event)) + (interactive (list nil last-nonmenu-event) gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5518,7 +5522,9 @@ If no internal viewer is available, use an external viewer." (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at (point)." (interactive - (list (gnus-completing-read "Action" (mapcar #'car gnus-mime-action-alist) t))) + (list (gnus-completing-read + "Action" (mapcar #'car gnus-mime-action-alist) t)) + gnus-article-mode) (gnus-article-check-buffer) (let ((action-pair (assoc action gnus-mime-action-alist))) (if action-pair @@ -5611,62 +5617,62 @@ If INTERACTIVE, call FUNCTION interactively." (defun gnus-article-pipe-part (n) "Pipe MIME part N, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'mm-pipe-part)) (defun gnus-article-save-part (n) "Save MIME part N, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'mm-save-part)) (defun gnus-article-interactively-view-part (n) "View MIME part N interactively, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'mm-interactively-view-part)) (defun gnus-article-copy-part (n) "Copy MIME part N, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-copy-part)) (defun gnus-article-view-part-as-charset (n) "View MIME part N using a specified charset. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) (defun gnus-article-view-part-externally (n) "View MIME part N externally, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) (defun gnus-article-inline-part (n) "Inline MIME part N, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-inline-part)) (defun gnus-article-save-part-and-strip (n) "Save MIME part N and replace it with an external body. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t)) (defun gnus-article-replace-part (n) "Replace MIME part N with an external body. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-replace-part t t)) (defun gnus-article-delete-part (n) "Delete MIME part N and add some information about the removed part. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-delete-part t)) (defun gnus-article-view-part-as-type (n) "Choose a MIME media type, and view part N as such. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t)) (defun gnus-article-mime-match-handle-first (condition) @@ -5693,7 +5699,7 @@ N is the numerical prefix." "View MIME part N, which is the numerical prefix. If the part is already shown, hide the part. If N is nil, view all parts." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (or (numberp n) (setq n (gnus-article-mime-match-handle-first gnus-article-mime-match-handle-function))) @@ -6383,7 +6389,7 @@ Provided for backwards compatibility." This function toggles the display when called interactively. Note that buttons to be added to the header are only the ones that aren't inlined in the body. Use `gnus-header-face-alist' to highlight buttons." - (interactive (list t)) + (interactive (list t) gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (let ((case-fold-search t) buttons st) (save-excursion @@ -6488,7 +6494,7 @@ the coding cookie." (defun gnus-narrow-to-page (&optional arg) "Narrow the article buffer to a page. If given a numerical ARG, move forward ARG pages." - (interactive "P") + (interactive "P" gnus-article-mode) (setq arg (if arg (prefix-numeric-value arg) 0)) (with-current-buffer gnus-article-buffer (widen) @@ -6541,7 +6547,7 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-next-page () "Show the next page of the article." - (interactive) + (interactive nil gnus-article-mode) (when (gnus-article-next-page) (goto-char (point-min)) (gnus-article-read-summary-keys nil ?n))) @@ -6549,7 +6555,7 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-prev-page () "Show the previous page of the article." - (interactive) + (interactive nil gnus-article-mode) (if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer? (gnus-article-read-summary-keys nil ?p) (gnus-article-prev-page nil))) @@ -6572,7 +6578,7 @@ If given a numerical ARG, move forward ARG pages." "Show the next page of the current article. If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." - (interactive "p") + (interactive "p" gnus-article-mode) (move-to-window-line (- -1 scroll-margin)) (if (and (not (and gnus-article-over-scroll (> (count-lines (window-start) (point-max)) @@ -6628,7 +6634,7 @@ specifies." (defun gnus-article-prev-page (&optional lines) "Show previous page of current article. Argument LINES specifies lines to be scrolled down." - (interactive "p") + (interactive "p" gnus-article-mode) (move-to-window-line 0) (if (and gnus-page-broken (bobp) @@ -6669,7 +6675,7 @@ not have a face in `gnus-article-boring-faces'." (defun gnus-article-refer-article () "Read article specified by message-id around point." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (re-search-backward "[ \t]\\|^" (point-at-bol) t) (re-search-forward "\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) (defun gnus-article-check-buffer () @@ -6703,7 +6709,7 @@ not have a face in `gnus-article-boring-faces'." (defun gnus-article-read-summary-keys (&optional _arg key not-restore-window) "Read a summary buffer key sequence and execute it from the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-check-buffer) (let ((nosaves '("q" "Q" "r" "m" "a" "f" "WDD" "WDW" @@ -6814,7 +6820,7 @@ not have a face in `gnus-article-boring-faces'." (ding)))))))) (defun gnus-article-read-summary-send-keys () - (interactive) + (interactive nil gnus-article-mode) (let ((unread-command-events (list ?S))) (gnus-article-read-summary-keys))) @@ -6822,7 +6828,8 @@ not have a face in `gnus-article-boring-faces'." "Display documentation of the function invoked by KEY. KEY is a string or a vector." (interactive (list (let ((cursor-in-echo-area t)) - (read-key-sequence "Describe key: ")))) + (read-key-sequence "Describe key: "))) + gnus-article-mode) (gnus-article-check-buffer) (if (memq (key-binding key t) '(gnus-article-read-summary-keys gnus-article-read-summary-send-keys)) @@ -6844,7 +6851,8 @@ KEY is a string or a vector." KEY is a string or a vector." (interactive (list (let ((cursor-in-echo-area t)) (read-key-sequence "Describe key: ")) - current-prefix-arg)) + current-prefix-arg) + gnus-article-mode) (gnus-article-check-buffer) (if (memq (key-binding key t) '(gnus-article-read-summary-keys gnus-article-read-summary-send-keys)) @@ -6871,7 +6879,7 @@ KEY is a string or a vector." "Show a list of all defined keys, and their definitions. The optional argument PREFIX, if non-nil, should be a key sequence; then we display only bindings that start with that prefix." - (interactive) + (interactive nil gnus-article-mode) (gnus-article-check-buffer) (let ((keymap (copy-keymap gnus-article-mode-map)) (map (copy-keymap gnus-article-send-map)) @@ -6930,7 +6938,7 @@ then we display only bindings that start with that prefix." "Start composing a reply mail to the current message. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive) + (interactive nil gnus-article-mode) (let ((article (cdr gnus-article-current)) contents) (if (not (and transient-mark-mode mark-active)) @@ -6948,14 +6956,14 @@ the entire article will be yanked." "Start composing a wide reply mail to the current message. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive) + (interactive nil gnus-article-mode) (gnus-article-reply-with-original t)) (defun gnus-article-followup-with-original () "Compose a followup to the current article. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive) + (interactive nil gnus-article-mode) (let ((article (cdr gnus-article-current)) contents) (if (not (and transient-mark-mode mark-active)) @@ -6974,7 +6982,8 @@ the entire article will be yanked." This means that signatures, cited text and (some) headers will be hidden. If given a prefix, show the hidden text instead." - (interactive (append (gnus-article-hidden-arg) (list 'force))) + (interactive (append (gnus-article-hidden-arg) (list 'force)) + gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (article-hide-headers arg) (article-hide-list-identifiers) @@ -7269,7 +7278,7 @@ This is an extended text-mode. This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only groups." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (when (and (not force) (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing")) @@ -7302,7 +7311,7 @@ groups." (defun gnus-article-edit-done (&optional arg) "Update the article edits and exit." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((func gnus-article-edit-done-function) (buf (current-buffer)) (start (window-start)) @@ -7336,7 +7345,7 @@ groups." (defun gnus-article-edit-exit () "Exit the article editing without updating." - (interactive) + (interactive nil gnus-article-mode) (when (or (not (buffer-modified-p)) (yes-or-no-p "Article modified; kill anyway? ")) (let ((curbuf (current-buffer)) @@ -7357,7 +7366,7 @@ groups." (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (goto-char (point-min)) (search-forward-regexp "^$" nil t) @@ -7875,7 +7884,7 @@ HEADER is a regexp to match a header. For a fuller explanation, see "Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, call it with the value of the `gnus-data' text property." - (interactive "e") + (interactive "e" gnus-article-mode) (set-buffer (window-buffer (posn-window (event-start event)))) (let* ((pos (posn-point (event-start event))) (data (get-text-property pos 'gnus-data)) @@ -7888,7 +7897,7 @@ call it with the value of the `gnus-data' text property." "Check text at point for a callback function. If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property." - (interactive (list last-nonmenu-event)) + (interactive (list last-nonmenu-event) gnus-article-mode) (save-excursion (when event (mouse-set-point event)) @@ -7902,7 +7911,7 @@ This function calls `gnus-article-highlight-headers', `gnus-article-highlight-citation', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode) (gnus-article-highlight-headers) (gnus-article-highlight-citation force) (gnus-article-highlight-signature) @@ -7914,14 +7923,14 @@ do the highlighting. See the documentation for those functions." This function calls `gnus-article-highlight-headers', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode) (gnus-article-highlight-headers) (gnus-article-highlight-signature) (gnus-article-add-buttons)) (defun gnus-article-highlight-headers () "Highlight article headers as specified by `gnus-header-face-alist'." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (let (regexp header-face field-face from hpoints fpoints) (dolist (entry gnus-header-face-alist) @@ -7955,7 +7964,7 @@ do the highlighting. See the documentation for those functions." "Highlight the signature in an article. It does this by highlighting everything after `gnus-signature-separator' using the face `gnus-signature'." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t)) (save-restriction @@ -7978,7 +7987,7 @@ It does this by highlighting everything after "Find external references in the article and make buttons of them. \"External references\" are things like Message-IDs and URLs, as specified by `gnus-button-alist'." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t) (case-fold-search t) @@ -8072,7 +8081,7 @@ url is put as the `gnus-button-url' overlay property on the button." ;; Add buttons to the head of an article. (defun gnus-article-add-buttons-to-head () "Add buttons to the head of the article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (let (beg end) (dolist (entry gnus-header-button-alist) @@ -8120,7 +8129,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-copy-string () "Copy the string in the button to the kill ring." - (interactive) + (interactive nil gnus-article-mode) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-string))) (when data @@ -8236,7 +8245,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-patch (library line) "Visit an Emacs Lisp library LIBRARY on line LINE." - (interactive) + (interactive nil gnus-article-mode) (let ((file (locate-library (file-name-nondirectory library)))) (unless file (error "Couldn't find library %s" library)) @@ -8428,7 +8437,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-next-page (&optional _args _more-args) "Go to the next page." - (interactive) + (interactive nil gnus-article-mode) (let ((win (selected-window))) (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-next-page) @@ -8436,7 +8445,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-prev-page (&optional _args _more-args) "Go to the prev page." - (interactive) + (interactive nil gnus-article-mode) (let ((win (selected-window))) (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) @@ -8460,7 +8469,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-button-next-page (_arg) "Go to the next page." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((win (selected-window))) (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-next-page) @@ -8468,7 +8477,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-button-prev-page (_arg) "Go to the prev page." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((win (selected-window))) (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) @@ -8602,9 +8611,10 @@ For example: (list (or gnus-article-encrypt-protocol (gnus-completing-read "Encrypt protocol" - (mapcar #'car gnus-article-encrypt-protocol-alist) - t)) - current-prefix-arg)) + (mapcar #'car gnus-article-encrypt-protocol-alist) + t)) + current-prefix-arg) + gnus-article-mode) ;; User might hit `K E' instead of `K e', so prompt once. (when (and gnus-article-encrypt-protocol gnus-novice-user) @@ -8728,7 +8738,7 @@ For example: (defun gnus-mime-security-button-menu (event prefix) "Construct a context-sensitive menu of security commands." - (interactive "e\nP") + (interactive "e\nP" gnus-article-mode) (save-window-excursion (let ((pos (event-start event))) (select-window (posn-window pos)) @@ -8885,12 +8895,12 @@ For example: (defun gnus-mime-security-save-part () "Save the security part under point." - (interactive) + (interactive nil gnus-article-mode) (gnus-mime-security-run-function 'mm-save-part)) (defun gnus-mime-security-pipe-part () "Pipe the security part under point to a process." - (interactive) + (interactive nil gnus-article-mode) (gnus-mime-security-run-function 'mm-pipe-part)) (provide 'gnus-art) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index bc41d5b149d..8c2a928ab98 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -168,7 +168,7 @@ So the cdr of each bookmark is an alist too.") ;;;###autoload (defun gnus-bookmark-set () "Set a bookmark for this article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-bookmark-maybe-load-default-file) (if (or (not (derived-mode-p 'gnus-summary-mode)) (not gnus-article-current)) @@ -483,7 +483,7 @@ Gnus bookmarks names preceded by a \"*\" have annotations. (defun gnus-bookmark-bmenu-toggle-infos (&optional show) "Toggle whether details are shown in the Gnus bookmark list. Optional argument SHOW means show them unconditionally." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (cond (show (setq gnus-bookmark-bmenu-toggle-infos nil) @@ -649,14 +649,14 @@ reposition and try again, else return nil." (defun gnus-bookmark-bmenu-show-details () "Show the annotation for the current bookmark in another window." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (let ((bookmark (gnus-bookmark-bmenu-bookmark))) (if (gnus-bookmark-bmenu-check-position) (gnus-bookmark-show-details bookmark)))) (defun gnus-bookmark-bmenu-mark () "Mark bookmark on this line to be displayed by \\\\[gnus-bookmark-bmenu-select]." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (beginning-of-line) (if (gnus-bookmark-bmenu-check-position) (let ((inhibit-read-only t)) @@ -668,7 +668,7 @@ reposition and try again, else return nil." (defun gnus-bookmark-bmenu-unmark (&optional backup) "Cancel all requested operations on bookmark on this line and move down. Optional BACKUP means move up." - (interactive "P") + (interactive "P" gnus-bookmark-bmenu-mode) (beginning-of-line) (if (gnus-bookmark-bmenu-check-position) (progn @@ -683,7 +683,7 @@ Optional BACKUP means move up." (defun gnus-bookmark-bmenu-backup-unmark () "Move up and cancel all requested operations on bookmark on line above." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (forward-line -1) (if (gnus-bookmark-bmenu-check-position) (progn @@ -695,7 +695,7 @@ Optional BACKUP means move up." "Mark Gnus bookmark on this line to be deleted. To carry out the deletions that you've marked, use \\\\[gnus-bookmark-bmenu-execute-deletions]." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (beginning-of-line) (if (gnus-bookmark-bmenu-check-position) (let ((inhibit-read-only t)) @@ -708,7 +708,7 @@ To carry out the deletions that you've marked, use "Mark bookmark on this line to be deleted, then move up one line. To carry out the deletions that you've marked, use \\\\[gnus-bookmark-bmenu-execute-deletions]." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (gnus-bookmark-bmenu-delete) (forward-line -2) (if (gnus-bookmark-bmenu-check-position) @@ -720,7 +720,7 @@ To carry out the deletions that you've marked, use You can mark bookmarks with the \\\\[gnus-bookmark-bmenu-mark] command." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (if (gnus-bookmark-bmenu-check-position) (let ((bmrk (gnus-bookmark-bmenu-bookmark)) (menu (current-buffer))) @@ -730,13 +730,13 @@ command." (bury-buffer menu)))) (defun gnus-bookmark-bmenu-select-by-mouse (event) - (interactive "e") + (interactive "e" gnus-bookmark-bmenu-mode) (mouse-set-point event) (gnus-bookmark-bmenu-select)) (defun gnus-bookmark-bmenu-load () "Load the Gnus bookmark file and rebuild the bookmark menu-buffer." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (if (gnus-bookmark-bmenu-check-position) (save-excursion (save-window-excursion @@ -745,7 +745,7 @@ command." (defun gnus-bookmark-bmenu-execute-deletions () "Delete Gnus bookmarks marked with \\\\[Buffer-menu-delete] commands." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (message "Deleting Gnus bookmarks...") (let ((hide-em gnus-bookmark-bmenu-toggle-infos) (o-point (point)) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 5ed731947bc..34dba54c11d 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -342,7 +342,7 @@ it's not cached." "Enter the next N articles into the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles entered." - (interactive "P") + (interactive "P" gnus-summary-mode) (let (out) (dolist (article (gnus-summary-work-articles n)) (gnus-summary-remove-process-mark article) @@ -363,7 +363,7 @@ Returns the list of articles entered." "Remove the next N articles from the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles removed." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-cache-change-buffer gnus-newsgroup-name) (let (out) (dolist (article (gnus-summary-work-articles n)) @@ -388,7 +388,7 @@ Returns the list of articles removed." (defun gnus-summary-insert-cached-articles () "Insert all the articles cached for this group into the current buffer." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-verbose (max 6 gnus-verbose))) (cond ((not gnus-newsgroup-cached) @@ -401,7 +401,7 @@ Returns the list of articles removed." (defun gnus-summary-limit-include-cached () "Limit the summary buffer to articles that are cached." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-verbose (max 6 gnus-verbose))) (if gnus-newsgroup-cached (progn diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 96f1a7de5ec..1f564f192b0 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -335,7 +335,7 @@ lines matches `message-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-suffix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode gnus-summary-mode) (with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer) (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) @@ -459,7 +459,7 @@ frame width. Sections that are heuristically interpreted as not being text (i.e., computer code and the like) will not be folded." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) @@ -529,7 +529,8 @@ text (i.e., computer code and the like) will not be folded." See the documentation for `gnus-article-highlight-citation'. If given a negative prefix, always show; if given a positive prefix, always hide." - (interactive (append (gnus-article-hidden-arg) (list 'force))) + (interactive (append (gnus-article-hidden-arg) (list 'force)) + gnus-article-mode gnus-summary-mode) (gnus-set-format 'cited-opened-text-button t) (gnus-set-format 'cited-closed-text-button t) (with-current-buffer gnus-article-buffer @@ -661,7 +662,8 @@ percent and at least `gnus-cite-hide-absolute' lines of the body is cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." - (interactive (append (gnus-article-hidden-arg) '(force))) + (interactive (append (gnus-article-hidden-arg) '(force)) + gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-delete-wash-type 'cite) (unless (gnus-article-check-hidden-text 'cite arg) @@ -689,7 +691,7 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (let ((article (cdr gnus-article-current))) (unless (with-current-buffer gnus-summary-buffer diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index d8f48b19f87..0852f8e1264 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -337,7 +337,8 @@ category.")) (defun gnus-group-customize (group &optional topic) "Edit the group or topic on the current line." - (interactive (list (gnus-group-group-name) (gnus-group-topic-name))) + (interactive (list (gnus-group-group-name) (gnus-group-topic-name)) + gnus-group-mode) (let (info (types (mapcar (lambda (entry) `(cons :format "%v%h\n" @@ -485,7 +486,7 @@ form, but who cares?" (defun gnus-group-customize-done (&rest _ignore) "Apply changes and bury the buffer." - (interactive) + (interactive nil gnus-custom-mode) (let ((params (widget-value gnus-custom-params))) (if gnus-custom-topic (gnus-topic-set-parameters gnus-custom-topic params) @@ -829,7 +830,7 @@ eh?"))) "Customize score file FILE. When called interactively, FILE defaults to the current score file. This can be changed using the `\\[gnus-score-change-score-file]' command." - (interactive (list gnus-current-score-file)) + (interactive (list gnus-current-score-file) gnus-summary-mode) (unless file (error "No score file for %s" gnus-newsgroup-name)) (let ((scores (gnus-score-load file)) @@ -1000,7 +1001,7 @@ articles in the thread. (defun gnus-agent-customize-category (category) "Edit the CATEGORY." - (interactive (list (gnus-category-name))) + (interactive (list (gnus-category-name)) gnus-custom-mode) (let ((info (assq category gnus-category-alist)) (defaults (list nil '(agent-predicate . false) (cons 'agent-enable-expiration diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index 0cee01b9428..944fd9795a2 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -76,10 +76,10 @@ DELAY is a string, giving the length of the time. Possible values are: The value of `message-draft-headers' determines which headers are generated when the article is delayed. Remaining headers are generated when the article is sent." - (interactive - (list (read-string - "Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): " - gnus-delay-default-delay))) + (interactive (list (read-string + "Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): " + gnus-delay-default-delay)) + message-mode) ;; Allow spell checking etc. (run-hooks 'message-send-hook) (let (num unit year month day hour minute deadline) ;; days diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 52705640bf0..64eb639f61c 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -214,7 +214,7 @@ There are currently two built-in format functions: (defun gnus-summary-sort-by-schedule (&optional reverse) "Sort nndiary summary buffers by schedule of appointments. Optional prefix (or REVERSE argument) means sort in reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'schedule reverse)) (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. @@ -322,7 +322,7 @@ This function checks that all NNDiary required headers are present and valid, and prompts for values / correction otherwise. If ARG (or prefix) is non-nil, force prompting for all fields." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (mapcar (lambda (head) diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index ca2d57de7dc..af0b782202a 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -124,7 +124,8 @@ filenames." (mapcar ;; don't attach directories (lambda (f) (if (file-directory-p f) nil f)) - (nreverse (dired-map-over-marks (dired-get-filename) nil)))))) + (nreverse (dired-map-over-marks (dired-get-filename) nil))))) + dired-mode) (let ((destination nil) (files-str nil) (bufs nil)) @@ -178,7 +179,8 @@ filenames." If ARG is non-nil, open it in a new buffer." (interactive (list (file-name-sans-versions (dired-get-filename) t) - current-prefix-arg)) + current-prefix-arg) + dired-mode) (mailcap-parse-mailcaps) (if (file-exists-p file-name) (let (mime-type method) @@ -216,7 +218,8 @@ that name. If PRINT-TO is a number, prompt the user for the name of the file to save in." (interactive (list (file-name-sans-versions (dired-get-filename) t) - (ps-print-preprint current-prefix-arg))) + (ps-print-preprint current-prefix-arg)) + dired-mode) (mailcap-parse-mailcaps) (cond ((file-directory-p file-name) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index f68e9d6b749..9a0f21359f8 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -71,7 +71,7 @@ (defun gnus-draft-toggle-sending (article) "Toggle whether to send an article or not." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) gnus-summary-mode) (if (gnus-draft-article-sendable-p article) (progn (push article gnus-newsgroup-unsendable) @@ -83,7 +83,7 @@ (defun gnus-draft-edit-message () "Enter a mail/post buffer to edit and send the draft." - (interactive) + (interactive nil gnus-summary-mode) (let ((article (gnus-summary-article-number)) (group gnus-newsgroup-name)) (gnus-draft-check-draft-articles (list article)) @@ -109,7 +109,7 @@ (defun gnus-draft-send-message (&optional n) "Send the current draft(s). Obeys the standard process/prefix convention." - (interactive "P") + (interactive "P" gnus-summary-mode) (let* ((articles (gnus-summary-work-articles n)) (total (length articles)) article) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index 265edf4d612..3fd8bf51de4 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -104,7 +104,7 @@ The optional LAYOUT overrides the `edit-form' window layout." (defun gnus-edit-form-done () "Update changes and kill the current buffer." - (interactive) + (interactive nil gnus-edit-form-mode) (goto-char (point-min)) (let ((form (condition-case nil (read (current-buffer)) @@ -115,7 +115,7 @@ The optional LAYOUT overrides the `edit-form' window layout." (defun gnus-edit-form-exit () "Kill the current buffer." - (interactive) + (interactive nil gnus-edit-form-mode) (let ((winconf gnus-prev-winconf)) (kill-buffer (current-buffer)) (set-window-configuration winconf))) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index f69c2ed12c2..c2e72aba933 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -132,11 +132,12 @@ For instance, to insert an X-Face use `gnus-random-x-face' as FUN Files matching `gnus-x-face-omit-files' are not considered." (interactive) - (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files - (lambda (file) - (gnus-shell-command-to-string - (format gnus-convert-pbm-to-x-face-command - (shell-quote-argument file)))))) + (gnus--random-face-with-type + gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files + (lambda (file) + (gnus-shell-command-to-string + (format gnus-convert-pbm-to-x-face-command + (shell-quote-argument file)))))) ;;;###autoload (defun gnus-insert-random-x-face-header () @@ -231,8 +232,8 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to Files matching `gnus-face-omit-files' are not considered." (interactive) (gnus--random-face-with-type gnus-face-directory "\\.png$" - gnus-face-omit-files - 'gnus-convert-png-to-face)) + gnus-face-omit-files + 'gnus-convert-png-to-face)) ;;;###autoload (defun gnus-insert-random-face-header () @@ -277,7 +278,6 @@ colors of the displayed X-Faces." (defun gnus-grab-cam-x-face () "Grab a picture off the camera and make it into an X-Face." - (interactive) (shell-command "xawtv-remote snap ppm") (let ((file nil)) (while (null (setq file (directory-files "/tftpboot/sparky/tmp" @@ -289,13 +289,11 @@ colors of the displayed X-Faces." (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>%s | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface" file null-device) (current-buffer)) - ;;(sleep-for 3) (delete-file file) (buffer-string)))) (defun gnus-grab-cam-face () "Grab a picture off the camera and make it into an X-Face." - (interactive) (shell-command "xawtv-remote snap ppm") (let ((file nil) (tempfile (make-temp-file "gnus-face-" nil ".ppm")) @@ -312,7 +310,6 @@ colors of the displayed X-Faces." (gnus-fun-ppm-change-string)))) (setq result (gnus-face-from-file tempfile))) (delete-file file) - ;;(delete-file tempfile) ; FIXME why are we not deleting it?! result)) (defun gnus-fun-ppm-change-string () diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 9ea9e100316..be57774fe96 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -125,7 +125,7 @@ callback for `gravatar-retrieve'." (defun gnus-treat-from-gravatar (&optional force) "Display gravatar in the From header. If gravatar is already displayed, remove it." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (if (memq 'from-gravatar gnus-article-wash-types) (gnus-delete-images 'from-gravatar) @@ -135,7 +135,7 @@ If gravatar is already displayed, remove it." (defun gnus-treat-mail-gravatar (&optional force) "Display gravatars in the Cc and To headers. If gravatars are already displayed, remove them." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (if (memq 'mail-gravatar gnus-article-wash-types) (gnus-delete-images 'mail-gravatar) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index e8b62a4133e..909391b6b0c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1160,7 +1160,7 @@ The following commands are available: (defun gnus-mouse-pick-group (e) "Enter the group under the mouse pointer." - (interactive "e") + (interactive "e" gnus-group-mode) (mouse-set-point e) (gnus-group-read-group nil)) @@ -1241,7 +1241,8 @@ Also see the `gnus-group-use-permanent-levels' variable." (or (gnus-group-default-level nil t) (gnus-group-default-list-level) - gnus-level-subscribed)))) + gnus-level-subscribed))) + gnus-group-mode) (unless level (setq level (car gnus-group-list-mode) unread (cdr gnus-group-list-mode))) @@ -1292,7 +1293,7 @@ Also see the `gnus-group-use-permanent-levels' variable." (defun gnus-group-list-level (level &optional all) "List groups on LEVEL. If ALL (the prefix), also list groups that have no unread articles." - (interactive "nList groups on level: \nP") + (interactive "nList groups on level: \nP" gnus-group-mode) (gnus-group-list-groups level all level)) (defun gnus-group-prepare-logic (group test) @@ -1866,7 +1867,7 @@ If FIRST-TOO, the current line is also eligible as a target." (defun gnus-group-mark-group (n &optional unmark no-advance) "Mark the current group." - (interactive "p") + (interactive "p" gnus-group-mode) (let ((buffer-read-only nil) group) (while (and (> n 0) @@ -1891,13 +1892,13 @@ If FIRST-TOO, the current line is also eligible as a target." (defun gnus-group-unmark-group (n) "Remove the mark from the current group." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-mark-group n 'unmark) (gnus-group-position-point)) (defun gnus-group-unmark-all-groups () "Unmark all groups." - (interactive) + (interactive nil gnus-group-mode) (save-excursion (mapc #'gnus-group-remove-mark gnus-group-marked)) (gnus-group-position-point)) @@ -1905,7 +1906,7 @@ If FIRST-TOO, the current line is also eligible as a target." (defun gnus-group-mark-region (unmark beg end) "Mark all groups between point and mark. If UNMARK, remove the mark instead." - (interactive "P\nr") + (interactive "P\nr" gnus-group-mode) (let ((num (count-lines beg end))) (save-excursion (goto-char beg) @@ -1914,12 +1915,12 @@ If UNMARK, remove the mark instead." (defun gnus-group-mark-buffer (&optional unmark) "Mark all groups in the buffer. If UNMARK, remove the mark instead." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-mark-region unmark (point-min) (point-max))) (defun gnus-group-mark-regexp (regexp) "Mark all groups that match some regexp." - (interactive "sMark (regexp): ") + (interactive "sMark (regexp): " gnus-group-mode) (let ((alist (cdr gnus-newsrc-alist)) group) (save-excursion @@ -2028,7 +2029,7 @@ number of the earliest articles in the group. If the optional argument NO-ARTICLE is non-nil, no article will be auto-selected upon group entry. If GROUP is non-nil, fetch that group." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((no-display (eq all 0)) (group (or group (gnus-group-group-name))) number active marked entry) @@ -2062,7 +2063,7 @@ If ALL is a positive number, fetch this number of the latest articles in the group. If ALL is a negative number, fetch this number of the earliest articles in the group." - (interactive "P") + (interactive "P" gnus-group-mode) (when (and (eobp) (not (gnus-group-group-name))) (forward-line -1)) (gnus-group-read-group all t)) @@ -2081,7 +2082,7 @@ buffer. If GROUP is nil, use current group. This might be useful if you want to toggle threading before entering the group." - (interactive "P") + (interactive "P" gnus-group-mode) (require 'gnus-score) (let (gnus-visual gnus-score-find-score-files-function @@ -2092,7 +2093,7 @@ before entering the group." (defun gnus-group-visible-select-group (&optional all) "Select the current group without hiding any articles." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((gnus-inhibit-limiting t)) (gnus-group-read-group all t))) @@ -2101,7 +2102,7 @@ before entering the group." You will actually be entered into a group that's a copy of the current group; no changes you make while in this group will be permanent." - (interactive) + (interactive nil gnus-group-mode) (require 'gnus-score) (let* (gnus-visual gnus-score-find-score-files-function gnus-apply-kill-hook @@ -2333,7 +2334,8 @@ specified by `gnus-gmane-group-download-format'." (list (gnus-group-completing-read "Gmane group") (read-number "Start article number: ") - (read-number "How many articles: "))) + (read-number "How many articles: ")) + gnus-group-mode) (unless range (setq range 500)) (when (< range 1) (error "Invalid range: %s" range)) @@ -2367,8 +2369,7 @@ Valid input formats include: ;; - The URLs should be added to `gnus-button-alist'. Probably we should ;; prompt the user to decide: "View via `browse-url' or in Gnus? " ;; (`gnus-read-ephemeral-gmane-group-url') - (interactive - (list (gnus-group-completing-read "Gmane URL"))) + (interactive (list (gnus-group-completing-read "Gmane URL")) gnus-group-mode) (let (group start range) (cond ;; URLs providing `group', `start' and `range': @@ -2543,7 +2544,8 @@ If PROMPT (the prefix) is a number, use the prompt specified in (or (and (stringp gnus-group-jump-to-group-prompt) gnus-group-jump-to-group-prompt) (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) - (and (stringp p) p))))))) + (and (stringp p) p)))))) + gnus-group-mode) (when (equal group "") (error "Empty group name")) @@ -2612,7 +2614,7 @@ Return nil if GROUP is not found." If N is negative, search backward instead. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group n t nil silent)) (defun gnus-group-next-unread-group (n &optional all level silent) @@ -2624,7 +2626,7 @@ such group can be found, the next group with a level higher than LEVEL. Returns the difference between N and the number of skips actually made." - (interactive "p") + (interactive "p" gnus-group-mode) (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) @@ -2641,14 +2643,14 @@ made." "Go to previous N'th newsgroup. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group (- n) t)) (defun gnus-group-prev-unread-group (n) "Go to previous N'th unread newsgroup. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group (- n))) (defun gnus-group-next-unread-group-same-level (n) @@ -2656,7 +2658,7 @@ done." If N is negative, search backward instead. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group n t (gnus-group-group-level)) (gnus-group-position-point)) @@ -2664,14 +2666,14 @@ done." "Go to next N'th unread newsgroup on the same level. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) (gnus-group-position-point)) (defun gnus-group-best-unread-group (&optional exclude-group) "Go to the group with the highest level. If EXCLUDE-GROUP, do not go to that group." - (interactive) + (interactive nil gnus-group-mode) (goto-char (point-min)) (let ((best 100000) unread best-point) @@ -2711,7 +2713,7 @@ If EXCLUDE-GROUP, do not go to that group." (defun gnus-group-first-unread-group () "Go to the first group with unread articles." - (interactive) + (interactive nil gnus-group-mode) (prog1 (let ((opoint (point)) unread) @@ -2727,13 +2729,13 @@ If EXCLUDE-GROUP, do not go to that group." (defun gnus-group-enter-server-mode () "Jump to the server buffer." - (interactive) + (interactive nil gnus-group-mode) (gnus-enter-server-buffer)) (defun gnus-group-make-group-simple (&optional group) "Add a new newsgroup. The user will be prompted for GROUP." - (interactive (list (gnus-group-completing-read))) + (interactive (list (gnus-group-completing-read)) gnus-group-mode) (gnus-group-make-group (gnus-group-real-name group) (gnus-group-server group) nil nil)) @@ -2749,7 +2751,8 @@ server." (interactive (list (gnus-read-group "Group name: ") - (gnus-read-method "Select method for new group (use tab for completion)"))) + (gnus-read-method "Select method for new group (use tab for completion)")) + gnus-group-mode) (when (stringp method) (setq method (or (gnus-server-to-method method) method))) @@ -2794,7 +2797,7 @@ server." (defun gnus-group-delete-groups (&optional arg) "Delete the current group. Only meaningful with editable groups." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((n (length (gnus-group-process-prefix arg)))) (when (gnus-yes-or-no-p (if (= n 1) @@ -2809,8 +2812,8 @@ server." If OLDP (the prefix), only delete articles that are \"old\", according to the expiry settings. Note that this will delete old not-expirable articles, too." - (interactive (list (gnus-group-group-name) - current-prefix-arg)) + (interactive (list (gnus-group-group-name) current-prefix-arg) + gnus-group-mode) (let ((articles (gnus-uncompress-range (gnus-active group)))) (when (gnus-yes-or-no-p (format "Do you really want to delete these %d articles forever? " @@ -2829,9 +2832,8 @@ doing the deletion. Note that you also have to specify FORCE if you want the group to be removed from the server, even when it's empty." - (interactive - (list (gnus-group-group-name) - current-prefix-arg)) + (interactive (list (gnus-group-group-name) current-prefix-arg) + gnus-group-mode) (unless group (error "No group to delete")) (unless (gnus-check-backend-function 'request-delete-group group) @@ -2865,7 +2867,8 @@ and NEW-NAME will be prompted for." "Rename group to: " (gnus-group-real-name group)) method (gnus-info-method (gnus-get-info group))) - (list group (gnus-group-prefixed-name new-name method)))) + (list group (gnus-group-prefixed-name new-name method))) + gnus-group-mode) (unless (gnus-check-backend-function 'request-rename-group group) (error "This back end does not support renaming groups")) @@ -2911,7 +2914,7 @@ and NEW-NAME will be prompted for." (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (let ((part (or part 'info)) info) (unless group @@ -2950,12 +2953,12 @@ and NEW-NAME will be prompted for." (defun gnus-group-edit-group-method (group) "Edit the select method of GROUP." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (gnus-group-edit-group group 'method)) (defun gnus-group-edit-group-parameters (group) "Edit the group parameters of GROUP." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (gnus-group-edit-group group 'params)) (defun gnus-group-edit-group-done (part group form) @@ -2993,14 +2996,16 @@ and NEW-NAME will be prompted for." (defun gnus-group-make-useful-group (group method) "Create one of the groups described in `gnus-useful-groups'." (interactive - (let ((entry (assoc (gnus-completing-read "Create group" - (mapcar #'car gnus-useful-groups) - t) + (let ((entry (assoc (gnus-completing-read + "Create group" + (mapcar #'car gnus-useful-groups) + t) gnus-useful-groups))) (list (cadr entry) - ;; Don't use `caddr' here since macros within the `interactive' - ;; form won't be expanded. - (car (cddr entry))))) + ;; Don't use `caddr' here since macros within the + ;; `interactive' form won't be expanded. + (car (cddr entry)))) + gnus-group-mode) (setq method (copy-tree method)) (let (entry) (while (setq entry (memq (assq 'eval method) method)) @@ -3014,7 +3019,7 @@ group already exists: - if not given, and error is signaled, - if t, stay silent, - if anything else, just print a message." - (interactive) + (interactive nil gnus-group-mode) (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) (file (nnheader-find-etc-directory "gnus-tut.txt" t))) (if (gnus-group-entry name) @@ -3040,9 +3045,9 @@ group already exists: "Create a group that uses a single file as the source. If called with a prefix argument, ask for the file type." - (interactive - (list (read-file-name "File name: ") - (and current-prefix-arg 'ask))) + (interactive (list (read-file-name "File name: ") + (and current-prefix-arg 'ask)) + gnus-group-mode) (when (eq type 'ask) (let ((err "") char found) @@ -3077,7 +3082,7 @@ If called with a prefix argument, ask for the file type." (defun gnus-group-make-web-group (&optional solid) "Create an ephemeral nnweb group. If SOLID (the prefix), create a solid group." - (interactive "P") + (interactive "P" gnus-group-mode) (require 'nnweb) (let* ((group (if solid (gnus-read-group "Group name: ") @@ -3117,7 +3122,7 @@ If SOLID (the prefix), create a solid group." (defun gnus-group-make-rss-group (&optional url) "Given a URL, discover if there is an RSS feed. If there is, use Gnus to create an nnrss group" - (interactive) + (interactive nil gnus-group-mode) (require 'nnrss) (if (not url) (setq url (read-from-minibuffer "URL to Search for RSS: "))) @@ -3158,8 +3163,8 @@ If there is, use Gnus to create an nnrss group" The user will be prompted for a directory. The contents of this directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." - (interactive - (list (read-directory-name "Create group from directory: "))) + (interactive (list (read-directory-name "Create group from directory: ")) + gnus-group-mode) (unless (file-exists-p dir) (error "No such directory")) (unless (file-directory-p dir) @@ -3192,7 +3197,7 @@ prefix arg NO-PARSE means that Gnus should not parse the search query before passing it to the underlying search engine. A non-nil SPECS arg must be an alist with `search-query-spec' and `search-group-spec' keys, and skips all prompting." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((name (gnus-read-group "Group name: "))) (with-current-buffer gnus-group-buffer (let* ((group-spec @@ -3246,7 +3251,7 @@ prefix arg NO-PARSE means that Gnus should not parse the search query before passing it to the underlying search engine. A non-nil SPECS arg must be an alist with `search-query-spec' and `search-group-spec' keys, and skips all prompting." - (interactive "P") + (interactive "P" gnus-group-mode) (let* ((group-spec (or (cdr (assq 'search-group-spec specs)) (cdr (assq 'nnir-group-spec specs)) @@ -3286,10 +3291,10 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." - (interactive - (list current-prefix-arg - (gnus-group-completing-read "Add to virtual group" - nil t "nnvirtual:"))) + (interactive (list current-prefix-arg + (gnus-group-completing-read "Add to virtual group" + nil t "nnvirtual:")) + gnus-group-mode) (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) (error "%s is not an nnvirtual group" vgroup)) (gnus-close-group vgroup) @@ -3307,7 +3312,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-make-empty-virtual (group) "Create a new, fresh, empty virtual group." - (interactive "sCreate new, empty virtual group: ") + (interactive "sCreate new, empty virtual group: " gnus-group-mode) (let* ((method (list 'nnvirtual "^$")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. @@ -3321,7 +3326,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-enter-directory (dir) "Enter an ephemeral nneething group." - (interactive "DDirectory to read: ") + (interactive "DDirectory to read: " gnus-group-mode) (let* ((method (list 'nneething dir '(nneething-read-only t))) (leaf (gnus-group-prefixed-name (file-name-nondirectory (directory-file-name dir)) @@ -3336,7 +3341,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-expunge-group (group) "Expunge deleted articles in current nnimap GROUP." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (let ((method (gnus-find-method-for-group group))) (if (not (gnus-check-backend-function 'request-expunge-group (car method))) @@ -3348,7 +3353,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-nnimap-edit-acl (group) "Edit the Access Control List of current nnimap GROUP." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (let ((mailbox (gnus-group-real-name group)) method acl) (unless group (error "No group on current line")) @@ -3395,7 +3400,8 @@ Editing the access control list for `%s'. When used interactively, the sorting function used will be determined by the `gnus-group-sort-function' variable. If REVERSE (the prefix), reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) + (interactive (list gnus-group-sort-function current-prefix-arg) + gnus-group-mode) (funcall gnus-group-sort-alist-function (gnus-make-sort-function func) reverse) (gnus-group-unmark-all-groups) @@ -3428,56 +3434,57 @@ value is disregarded." (defun gnus-group-sort-groups-by-alphabet (&optional reverse) "Sort the group buffer alphabetically by group name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) (defun gnus-group-sort-groups-by-real-name (&optional reverse) "Sort the group buffer alphabetically by real (unprefixed) group name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse)) (defun gnus-group-sort-groups-by-unread (&optional reverse) "Sort the group buffer by number of unread articles. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) (defun gnus-group-sort-groups-by-level (&optional reverse) "Sort the group buffer by group level. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) (defun gnus-group-sort-groups-by-score (&optional reverse) "Sort the group buffer by group score. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) (defun gnus-group-sort-groups-by-rank (&optional reverse) "Sort the group buffer by group rank. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) (defun gnus-group-sort-groups-by-method (&optional reverse) "Sort the group buffer alphabetically by back end name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) (defun gnus-group-sort-groups-by-server (&optional reverse) "Sort the group buffer alphabetically by server name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-server reverse)) ;;; Selected group sorting. (defun gnus-group-sort-selected-groups (n func &optional reverse) "Sort the process/prefixed groups." - (interactive (list current-prefix-arg gnus-group-sort-function)) + (interactive (list current-prefix-arg gnus-group-sort-function) + gnus-group-mode) (let ((groups (gnus-group-process-prefix n))) (funcall gnus-group-sort-selected-function groups (gnus-make-sort-function func) reverse) @@ -3509,49 +3516,49 @@ If REVERSE is non-nil, reverse the sorting." "Sort the group buffer alphabetically by group name. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) (defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse) "Sort the group buffer alphabetically by real group name. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse)) (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) "Sort the group buffer by number of unread articles. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse)) (defun gnus-group-sort-selected-groups-by-level (&optional n reverse) "Sort the group buffer by group level. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse)) (defun gnus-group-sort-selected-groups-by-score (&optional n reverse) "Sort the group buffer by group score. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse)) (defun gnus-group-sort-selected-groups-by-rank (&optional n reverse) "Sort the group buffer by group rank. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) (defun gnus-group-sort-selected-groups-by-method (&optional n reverse) "Sort the group buffer alphabetically by back end name. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse)) ;;; Sorting predicates. @@ -3609,7 +3616,7 @@ sort in reverse order." (defun gnus-group-clear-data (&optional arg) "Clear all marks and read ranges from the current group. Obeys the process/prefix convention." - (interactive "P") + (interactive "P" gnus-group-mode) (when (gnus-y-or-n-p "Really clear data? ") (gnus-group-iterate arg (lambda (group) @@ -3621,7 +3628,7 @@ Obeys the process/prefix convention." (defun gnus-group-clear-data-on-native-groups () "Clear all marks and read ranges from all native groups." - (interactive) + (interactive nil gnus-group-mode) (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ") (let ((alist (cdr gnus-newsrc-alist)) info) @@ -3665,7 +3672,7 @@ caught up. If ALL is non-nil, marked articles will also be marked as read. Cross references (Xref: header) of articles are ignored. The number of newsgroups that this function was unable to catch up is returned." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((groups (gnus-group-process-prefix n)) (ret 0) group) @@ -3704,7 +3711,7 @@ up is returned." (defun gnus-group-catchup-current-all (&optional n) "Mark all articles in current newsgroup as read. Cross references (Xref: header) of articles are ignored." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-catchup-current n 'all)) (declare-function gnus-sequence-of-unread-articles "gnus-sum" (group)) @@ -3751,7 +3758,7 @@ or nil if no action could be taken." (defun gnus-group-expire-articles (&optional n) "Expire all expirable articles in the current newsgroup. Uses the process/prefix convention." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((groups (gnus-group-process-prefix n)) group) (unless groups @@ -3797,7 +3804,7 @@ Uses the process/prefix convention." (defun gnus-group-expire-all-groups () "Expire all expirable articles in all newsgroups." - (interactive) + (interactive nil gnus-group-mode) (save-excursion (gnus-message 5 "Expiring...") (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) @@ -3821,7 +3828,8 @@ Uses the process/prefix convention." (if (string-match "^\\s-*$" s) (int-to-string (or (gnus-group-group-level) gnus-level-default-subscribed)) - s)))))) + s))))) + gnus-group-mode) (unless (and (>= level 1) (<= level gnus-level-killed)) (error "Invalid level: %d" level)) (dolist (group (gnus-group-process-prefix n)) @@ -3837,18 +3845,18 @@ Uses the process/prefix convention." (defun gnus-group-unsubscribe (&optional n) "Unsubscribe the current group." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-unsubscribe-current-group n 'unsubscribe)) (defun gnus-group-subscribe (&optional n) "Subscribe the current group." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-unsubscribe-current-group n 'subscribe)) (defun gnus-group-unsubscribe-current-group (&optional n do-sub) "Toggle subscription of the current group. If given numerical prefix, toggle the N next groups." - (interactive "P") + (interactive "P" gnus-group-mode) (dolist (group (gnus-group-process-prefix n)) (gnus-group-remove-mark group) (gnus-group-unsubscribe-group @@ -3871,7 +3879,8 @@ If given numerical prefix, toggle the N next groups." Killed newsgroups are subscribed. If SILENT, don't try to update the group line." (interactive (list (gnus-group-completing-read - nil nil (gnus-read-active-file-p)))) + nil nil (gnus-read-active-file-p))) + gnus-group-mode) (let ((newsrc (gnus-group-entry group))) (cond ((string-match "\\`[ \t]*\\'" group) @@ -3905,7 +3914,7 @@ group line." "Move the current newsgroup up N places. If given a negative prefix, move down instead. The difference between N and the number of steps taken is returned." - (interactive "p") + (interactive "p" gnus-group-mode) (unless (gnus-group-group-name) (error "No group on current line")) (gnus-group-kill-group 1) @@ -3917,7 +3926,8 @@ N and the number of steps taken is returned." (defun gnus-group-kill-all-zombies (&optional dummy) "Kill all zombie newsgroups. The optional DUMMY should always be nil." - (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? ")))) + (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))) + gnus-group-mode) (unless dummy (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) (setq gnus-zombie-list nil) @@ -3927,7 +3937,7 @@ The optional DUMMY should always be nil." (defun gnus-group-kill-region (begin end) "Kill newsgroups in current region (excluding current point). The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." - (interactive "r") + (interactive "r" gnus-group-mode) (let ((lines ;; Count lines. (save-excursion @@ -3949,7 +3959,7 @@ However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. The return value is the name of the group that was killed, or a list of groups killed." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((buffer-read-only nil) (groups (gnus-group-process-prefix n)) group entry level out) @@ -4009,7 +4019,7 @@ of groups killed." The numeric ARG specifies how many newsgroups are to be yanked. The name of the newsgroup yanked is returned, or (if several groups are yanked) a list of yanked groups is returned." - (interactive "p") + (interactive "p" gnus-group-mode) (setq arg (or arg 1)) (let (info group prev out) (while (>= (cl-decf arg) 0) @@ -4034,7 +4044,7 @@ yanked) a list of yanked groups is returned." (defun gnus-group-kill-level (level) "Kill all groups that is on a certain LEVEL." - (interactive "nKill all groups on level: ") + (interactive "nKill all groups on level: " gnus-group-mode) (cond ((= level gnus-level-zombie) (setq gnus-killed-list @@ -4065,7 +4075,7 @@ yanked) a list of yanked groups is returned." "List all newsgroups with level ARG or lower. Default is `gnus-level-unsubscribed', which lists all subscribed and most unsubscribed groups." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) ;; Redefine this to list ALL killed groups if prefix arg used. @@ -4074,7 +4084,7 @@ unsubscribed groups." "List all killed newsgroups in the group buffer. If ARG is non-nil, list ALL killed groups known to Gnus. This may entail asking the server for the groups." - (interactive "P") + (interactive "P" gnus-group-mode) ;; Find all possible killed newsgroups if arg. (when arg (gnus-get-killed-groups)) @@ -4088,7 +4098,7 @@ entail asking the server for the groups." (defun gnus-group-list-zombies () "List all zombie newsgroups in the group buffer." - (interactive) + (interactive nil gnus-group-mode) (if (not gnus-zombie-list) (gnus-message 6 "No zombie groups") (let (gnus-group-list-mode) @@ -4099,7 +4109,7 @@ entail asking the server for the groups." (defun gnus-group-list-active () "List all groups that are available from the server(s)." - (interactive) + (interactive nil gnus-group-mode) ;; First we make sure that we have really read the active file. (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t) @@ -4121,7 +4131,7 @@ entail asking the server for the groups." (defun gnus-activate-all-groups (level) "Activate absolutely all groups." - (interactive (list gnus-level-unsubscribed)) + (interactive (list gnus-level-unsubscribed) gnus-group-mode) (let ((gnus-activate-level level) (gnus-activate-foreign-newsgroups level)) (gnus-group-get-new-news))) @@ -4133,7 +4143,7 @@ re-scanning. If ARG is non-nil and not a number, this will force \"hard\" re-reading of the active files from all servers. If ONE-LEVEL is not nil, then re-scan only the specified level, otherwise all levels below ARG will be scanned too." - (interactive "P") + (interactive "P" gnus-group-mode) (require 'nnmail) (let ((gnus-inhibit-demon t) ;; Binding this variable will inhibit multiple fetchings @@ -4163,7 +4173,7 @@ otherwise all levels below ARG will be scanned too." The difference between N and the number of newsgroup checked is returned. If N is negative, this group and the N-1 previous groups will be checked. If DONT-SCAN is non-nil, scan non-activated groups as well." - (interactive "P") + (interactive "P" gnus-group-mode) (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) (beg (unless n @@ -4208,7 +4218,8 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." - (interactive (list current-prefix-arg (gnus-group-group-name))) + (interactive (list current-prefix-arg (gnus-group-group-name)) + gnus-group-mode) (let* ((method (gnus-find-method-for-group group)) (mname (gnus-group-prefixed-name "" method)) desc) @@ -4230,7 +4241,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." ;; Suggested by Per Abrahamsen . (defun gnus-group-describe-all-groups (&optional force) "Pop up a buffer with descriptions of all newsgroups." - (interactive "P") + (interactive "P" gnus-group-mode) (when force (setq gnus-description-hashtb nil)) (when (not (or gnus-description-hashtb @@ -4255,7 +4266,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." ;; Suggested by Daniel Quinlan . (defun gnus-group-apropos (regexp &optional search-description) "List all newsgroups that have names that match a regexp." - (interactive "sGnus apropos (regexp): ") + (interactive "sGnus apropos (regexp): " gnus-group-mode) (let ((prev "") (obuf (current-buffer)) groups des) @@ -4294,7 +4305,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (defun gnus-group-description-apropos (regexp) "List all newsgroups that have names or descriptions that match REGEXP." - (interactive "sGnus description apropos (regexp): ") + (interactive "sGnus description apropos (regexp): " gnus-group-mode) (when (not (or gnus-description-hashtb (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) @@ -4309,7 +4320,7 @@ If ALL, also list groups with no unread articles. If LOWEST, don't list groups with level lower than LOWEST. This command may read the active file." - (interactive "P\nsList newsgroups matching: ") + (interactive "P\nsList newsgroups matching: " gnus-group-mode) ;; First make sure active file has been read. (when (and level (> (prefix-numeric-value level) gnus-level-killed)) @@ -4324,7 +4335,7 @@ This command may read the active file." If the prefix LEVEL is non-nil, it should be a number that says which level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." - (interactive "P\nsList newsgroups matching: ") + (interactive "P\nsList newsgroups matching: " gnus-group-mode) (when level (setq level (prefix-numeric-value level))) (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) @@ -4333,12 +4344,12 @@ If LOWEST, don't list groups with level lower than LOWEST." (defun gnus-group-save-newsrc (&optional force) "Save the Gnus startup files. If FORCE, force saving whether it is necessary or not." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-save-newsrc-file force)) (defun gnus-group-restart (&optional _arg) "Force Gnus to read the .newsrc file." - (interactive) + (interactive nil gnus-group-mode) (when (gnus-yes-or-no-p (format "Are you sure you want to restart Gnus? ")) (gnus-save-newsrc-file) @@ -4347,7 +4358,7 @@ If FORCE, force saving whether it is necessary or not." (defun gnus-group-read-init-file () "Read the Gnus elisp init file." - (interactive) + (interactive nil gnus-group-mode) (gnus-read-init-file) (gnus-message 5 "Read %s" gnus-init-file)) @@ -4355,7 +4366,7 @@ If FORCE, force saving whether it is necessary or not." "Check bogus newsgroups. If given a prefix, don't ask for confirmation before removing a bogus group." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) (gnus-group-list-groups)) @@ -4366,7 +4377,7 @@ With 1 C-u, use the `ask-server' method to query the server for new groups. With 2 C-u's, use most complete method possible to query the server for new groups, and subscribe the new groups as zombies." - (interactive "p") + (interactive "p" gnus-group-mode) (let ((new-groups (gnus-find-new-newsgroups (or arg 1))) current-group) (gnus-group-list-groups) @@ -4379,7 +4390,7 @@ for new groups, and subscribe the new groups as zombies." (defun gnus-group-edit-global-kill (&optional article group) "Edit the global kill file. If GROUP, edit that local kill file instead." - (interactive "P") + (interactive "P" gnus-group-mode) (setq gnus-current-kill-article article) (gnus-kill-file-edit-file group) (gnus-message 6 "Editing a %s kill file (Type %s to exit)" @@ -4388,12 +4399,12 @@ If GROUP, edit that local kill file instead." (defun gnus-group-edit-local-kill (article group) "Edit a local kill file." - (interactive (list nil (gnus-group-group-name))) + (interactive (list nil (gnus-group-group-name)) gnus-group-mode) (gnus-group-edit-global-kill article group)) (defun gnus-group-force-update () "Update `.newsrc' file." - (interactive) + (interactive nil gnus-group-mode) (gnus-save-newsrc-file)) (defvar gnus-backlog-articles) @@ -4402,7 +4413,7 @@ If GROUP, edit that local kill file instead." "Suspend the current Gnus session. In fact, cleanup buffers except for group mode buffer. The hook `gnus-suspend-gnus-hook' is called before actually suspending." - (interactive) + (interactive nil gnus-group-mode) (gnus-run-hooks 'gnus-suspend-gnus-hook) (gnus-offer-save-summaries) ;; Kill Gnus buffers except for group mode buffer. @@ -4425,14 +4436,14 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending." (defun gnus-group-clear-dribble () "Clear all information from the dribble buffer." - (interactive) + (interactive nil gnus-group-mode) (gnus-dribble-clear) (gnus-message 7 "Cleared dribble buffer")) (defun gnus-group-exit () "Quit reading news after updating .newsrc.eld and .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) + (interactive nil gnus-group-mode) (when (or noninteractive ;For gnus-batch-kill (not gnus-interactive-exit) ;Without confirmation @@ -4466,7 +4477,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (defun gnus-group-quit () "Quit reading news without updating .newsrc.eld or .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) + (interactive nil gnus-group-mode) (when (or noninteractive ;For gnus-batch-kill (zerop (buffer-size)) (not (gnus-server-opened gnus-select-method)) @@ -4491,7 +4502,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (defun gnus-group-describe-briefly () "Give a one line description of the group mode commands." - (interactive) + (interactive nil gnus-group-mode) (gnus-message 7 "%s" (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) (defun gnus-group-browse-foreign-server (method) @@ -4504,7 +4515,7 @@ and the second element is the address." (list (let ((how (gnus-completing-read "Which back end" (mapcar #'car (append gnus-valid-select-methods - gnus-server-alist)) + gnus-server-alist)) t (cons "nntp" 0) 'gnus-method-history))) ;; We either got a back end name or a virtual server name. ;; If the first, we also need an address. @@ -4520,7 +4531,8 @@ and the second element is the address." gnus-secondary-servers (cdr gnus-select-method)))) ;; We got a server name. - how)))) + how))) + gnus-group-mode) (gnus-browse-foreign-server method)) (defun gnus-group-set-info (info &optional method-only-group part) @@ -4678,7 +4690,7 @@ level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST. This command may read the active file." - (interactive "P") + (interactive "P" gnus-group-mode) (when level (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) @@ -4709,7 +4721,7 @@ level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST. This command may read the active file." - (interactive "P") + (interactive "P" gnus-group-mode) (when level (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) @@ -4731,7 +4743,7 @@ level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST. This command may read the active file." - (interactive "P") + (interactive "P" gnus-group-mode) (when level (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) @@ -4759,7 +4771,7 @@ This command may read the active file." (defun gnus-group-list-plus (&optional _args) "List groups plus the current selection." - (interactive) + (interactive nil gnus-group-mode) (let ((gnus-group-listed-groups (gnus-group-listed-groups)) (gnus-group-list-mode gnus-group-list-mode) ;; Save it. func) @@ -4775,7 +4787,7 @@ This command may read the active file." (defun gnus-group-list-flush (&optional args) "Flush groups from the current selection." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((gnus-group-list-option 'flush)) (gnus-group-list-plus args))) @@ -4786,7 +4798,7 @@ with this command. If you've first limited to groups with dormant articles with `A ?', you can then further limit with `A / c', which will then limit to groups with cached articles, giving you the groups that have both dormant articles and cached articles." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((gnus-group-list-option 'limit)) (gnus-group-list-plus args))) @@ -4839,7 +4851,7 @@ operation is only meaningful for back ends using one file per article \(e.g. nnml). Note: currently only implemented in nnml." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (unless group (error "No group to compact")) (unless (gnus-check-backend-function 'request-compact-group group) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 9811e8b440f..1b2743c1484 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -970,7 +970,7 @@ These will be used to retrieve the RSVP information from ical events." (defun gnus-icalendar-save-event () "Save the Calendar event in the text/calendar part under point." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data @@ -978,28 +978,28 @@ These will be used to retrieve the RSVP information from ical events." (defun gnus-icalendar-reply-accept () "Accept invitation in the current article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event)) (setq-local gnus-icalendar-reply-status 'accepted))) (defun gnus-icalendar-reply-tentative () "Send tentative response to invitation in the current article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event)) (setq-local gnus-icalendar-reply-status 'tentative))) (defun gnus-icalendar-reply-decline () "Decline invitation in the current article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event)) (setq-local gnus-icalendar-reply-status 'declined))) (defun gnus-icalendar-event-export () "Export calendar event to `org-mode', or update existing agenda entry." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-icalendar-sync-event-to-org gnus-icalendar-event)) ;; refresh article buffer in case the reply had been sent before initial org @@ -1009,14 +1009,14 @@ These will be used to retrieve the RSVP information from ical events." (defun gnus-icalendar-event-show () "Display `org-mode' agenda entry related to the calendar event." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-icalendar--show-org-event (with-current-buffer gnus-article-buffer gnus-icalendar-event))) (defun gnus-icalendar-event-check-agenda () "Display `org-mode' agenda for days between event start and end dates." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-icalendar-show-org-agenda (with-current-buffer gnus-article-buffer gnus-icalendar-event))) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 64928623e6a..01053797b3a 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -662,7 +662,7 @@ This is the string that Gnus uses to identify the group." "Look up the current article in the group where it originated. This command only makes sense for groups shows articles gathered from other groups -- for instance, search results and the like." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) (or diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el index fc8d9be8d6d..df076c11759 100644 --- a/lisp/gnus/gnus-mh.el +++ b/lisp/gnus/gnus-mh.el @@ -53,7 +53,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-folder)) (gnus-summary-save-article arg))) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 61b76381a0b..d7851f26290 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -653,7 +653,7 @@ network. The corresponding back end must have a `request-post' method." If ARG, post to group under point. If ARG is 1, prompt for group name. Depending on the selected group, the message might be either a mail or a news." - (interactive "P") + (interactive "P" gnus-group-mode) ;; Bind this variable here to make message mode hooks work ok. (let ((gnus-newsgroup-name (if arg @@ -672,7 +672,7 @@ a news." Use the posting of the current group by default. If ARG, don't do that. If ARG is 1, prompt for group name to find the posting style." - (interactive "P") + (interactive "P" gnus-summary-mode) (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -695,7 +695,7 @@ If ARG, don't do that. If ARG is 1, prompt for group name to post to. This function prepares a news even when using mail groups. This is useful for posting messages to mail groups without actually sending them over the network. The corresponding back end must have a `request-post' method." - (interactive "P") + (interactive "P" gnus-summary-mode) (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -722,7 +722,7 @@ network. The corresponding back end must have a `request-post' method." If ARG, don't do that. If ARG is 1, prompt for a group name to post to. Depending on the selected group, the message might be either a mail or a news." - (interactive "P") + (interactive "P" gnus-summary-mode) ;; Bind this variable here to make message mode hooks work ok. (let ((gnus-newsgroup-name (if arg @@ -742,9 +742,9 @@ If prefix argument YANK is non-nil, the original article is yanked automatically. YANK is a list of elements, where the car of each element is the article number, and the cdr is the string to be yanked." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (when yank (gnus-summary-goto-subject (if (listp (car yank)) @@ -764,19 +764,19 @@ article number, and the cdr is the string to be yanked." "Compose a followup to an article and include the original article. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-followup (gnus-summary-work-articles n) force-news)) (defun gnus-summary-followup-to-mail (&optional arg) "Followup to the current mail message via news." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (gnus-summary-followup arg t)) (defun gnus-summary-followup-to-mail-with-original (&optional arg) "Followup to the current mail message via news." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-followup (gnus-summary-work-articles arg) t)) (defun gnus-inews-yank-articles (articles) @@ -811,7 +811,7 @@ active, the entire article will be yanked." Uses the process-prefix convention. If given the symbolic prefix `a', cancel using the standard posting method; if not post using the current select method." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-summary-mode) (let ((message-post-method (let ((gn gnus-newsgroup-name)) (lambda (_arg) (gnus-post-method (eq symp 'a) gn)))) @@ -841,7 +841,7 @@ post using the current select method." "Compose an article that will supersede a previous article. This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." - (interactive) + (interactive nil gnus-summary-mode) (let ((article (gnus-summary-article-number)) (mail-parse-charset gnus-newsgroup-charset)) (gnus-setup-message 'reply-yank @@ -1080,7 +1080,6 @@ If SILENT, don't prompt the user." (defun gnus-extended-version () "Stringified Gnus version and Emacs version. See the variable `gnus-user-agent'." - (interactive) (if (stringp gnus-user-agent) gnus-user-agent ;; `gnus-user-agent' is a list: @@ -1109,9 +1108,9 @@ If prefix argument YANK is non-nil, the original article is yanked automatically. If WIDE, make a wide reply. If VERY-WIDE, make a very wide reply." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) ;; Allow user to require confirmation before replying by mail to the ;; author of a news article (or mail message). (when (or (not (or (gnus-news-group-p gnus-newsgroup-name) @@ -1179,14 +1178,14 @@ If VERY-WIDE, make a very wide reply." (defun gnus-summary-reply-with-original (n &optional wide) "Start composing a reply mail to the current message. The original article will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-reply (gnus-summary-work-articles n) wide)) (defun gnus-summary-reply-to-list-with-original (n &optional wide) "Start composing a reply mail to the current message. The reply goes only to the mailing list. The original article will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((message-reply-to-function (lambda nil `((To . ,(gnus-mailing-list-followup-to)))))) @@ -1198,32 +1197,32 @@ If prefix argument YANK is non-nil, the original article is yanked automatically. If WIDE, make a wide reply. If VERY-WIDE, make a very wide reply." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (let ((gnus-msg-force-broken-reply-to t)) (gnus-summary-reply yank wide very-wide))) (defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide) "Like `gnus-summary-reply-with-original' except removing reply-to field. The original article will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide)) (defun gnus-summary-wide-reply (&optional yank) "Start composing a wide reply mail to the current message. If prefix argument YANK is non-nil, the original article is yanked automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (gnus-summary-reply yank t)) (defun gnus-summary-wide-reply-with-original (n) "Start composing a wide reply mail to the current message. The original article(s) will be yanked. Uses the process/prefix convention." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-reply-with-original n t)) (defun gnus-summary-very-wide-reply (&optional yank) @@ -1236,9 +1235,9 @@ messages as the To/Cc headers. If prefix argument YANK is non-nil, the original article(s) will be yanked automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (gnus-summary-reply yank t (gnus-summary-work-articles yank))) (defun gnus-summary-very-wide-reply-with-original (n) @@ -1250,7 +1249,7 @@ The reply will include all From/Cc headers from the original messages as the To/Cc headers. The original article(s) will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-reply (gnus-summary-work-articles n) t (gnus-summary-work-articles n))) @@ -1266,7 +1265,7 @@ otherwise, use flipped `message-forward-as-mime'. If POST, post instead of mail. For the \"inline\" alternatives, also see the variable `message-forward-ignored-headers'." - (interactive "P") + (interactive "P" gnus-summary-mode) (if (cdr (gnus-summary-work-articles nil)) ;; Process marks are given. (gnus-uu-digest-mail-forward nil post) @@ -1355,7 +1354,8 @@ the message before resending." ;; initial-contents. (with-current-buffer gnus-original-article-buffer (nnmail-fetch-field "to")))) - current-prefix-arg)) + current-prefix-arg) + gnus-summary-mode) (let ((message-header-setup-hook (copy-sequence message-header-setup-hook)) (message-sent-hook (copy-sequence message-sent-hook)) ;; Honor posting-style for `name' and `address' in Resent-From header. @@ -1408,7 +1408,7 @@ the message before resending." A new buffer will be created to allow the user to modify body and contents of the message, and then, everything will happen as when composing a new message." - (interactive) + (interactive nil gnus-summary-mode) (let ((mail-parse-charset gnus-newsgroup-charset)) (gnus-setup-message 'reply-yank (gnus-summary-select-article t) @@ -1436,12 +1436,12 @@ composing a new message." (defun gnus-summary-post-forward (&optional arg) "Forward the current article to a newsgroup. See `gnus-summary-mail-forward' for ARG." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mail-forward arg t)) (defun gnus-summary-mail-crosspost-complaint (n) "Send a complaint about crossposting to the current article(s)." - (interactive "P") + (interactive "P" gnus-summary-mode) (dolist (article (gnus-summary-work-articles n)) (set-buffer gnus-summary-buffer) (gnus-summary-goto-subject article) @@ -1509,9 +1509,9 @@ Already submitted bugs can be found in the Emacs bug tracker: (defun gnus-summary-yank-message (buffer n) "Yank the current article into a composed message." - (interactive - (list (gnus-completing-read "Buffer" (message-buffers) t) - current-prefix-arg)) + (interactive (list (gnus-completing-read "Buffer" (message-buffers) t) + current-prefix-arg) + gnus-summary-mode) (gnus-summary-iterate n (let ((gnus-inhibit-treatment t)) (gnus-summary-select-article)) @@ -1528,7 +1528,7 @@ contains some mail you have written which has been bounced back to you. If FETCH, try to fetch the article that this is a reply to, if indeed this is a reply." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-select-article t) (let (summary-buffer parent) (if fetch @@ -1571,7 +1571,6 @@ this is a reply." ;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) - (interactive) (save-excursion (save-restriction (message-narrow-to-headers) @@ -1964,7 +1963,7 @@ created. This command uses the process/prefix convention, so if you process-mark several articles, they will all be attached." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((buffers (message-buffers)) destination) ;; Set up the destination mail composition buffer. diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 7927b88c3de..fd4d3b8a762 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -244,7 +244,7 @@ replacement is added." (gnus-picon-insert-glyph (pop spec) category)))))))))) (defun gnus-picon-transform-newsgroups (header) - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (gnus-article-goto-header header) (mail-header-narrow-to-field) @@ -283,7 +283,7 @@ replacement is added." (defun gnus-treat-from-picon () "Display picons in the From header. If picons are already displayed, remove them." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) @@ -294,7 +294,7 @@ If picons are already displayed, remove them." (defun gnus-treat-mail-picon () "Display picons in the Cc and To headers. If picons are already displayed, remove them." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types)) @@ -306,7 +306,7 @@ If picons are already displayed, remove them." (defun gnus-treat-newsgroups-picon () "Display picons in the Newsgroups and Followup-To headers. If picons are already displayed, remove them." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types)) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 147550d8cf3..9a22256113c 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -813,7 +813,7 @@ Consults `gnus-registry-ignored-groups' and (defun gnus-registry-wash-for-keywords (&optional force) "Get the keywords of the current article. Overrides existing keywords with FORCE set non-nil." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((id (gnus-registry-fetch-message-id-fast gnus-current-article)) word words) (if (or (not (gnus-registry-get-id-key id 'keyword)) @@ -1039,13 +1039,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install." (defun gnus-registry-set-article-mark (&rest articles) "Apply a mark to process-marked ARTICLES." - (interactive (gnus-summary-work-articles current-prefix-arg)) + (interactive (gnus-summary-work-articles current-prefix-arg) + gnus-article-mode gnus-summary-mode) (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles nil t)) (defun gnus-registry-remove-article-mark (&rest articles) "Remove a mark from process-marked ARTICLES." - (interactive (gnus-summary-work-articles current-prefix-arg)) + (interactive (gnus-summary-work-articles current-prefix-arg) + gnus-article-mode gnus-summary-mode) (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles t t)) @@ -1069,7 +1071,8 @@ Uses `gnus-registry-marks' to find what shortcuts to install." "Get the Gnus registry marks for ARTICLES and show them if interactive. Uses process/prefix conventions. For multiple articles, only the last one's marks are returned." - (interactive (gnus-summary-work-articles 1)) + (interactive (gnus-summary-work-articles 1) + gnus-article-mode gnus-summary-mode) (let* ((article (last articles)) (id (gnus-registry-fetch-message-id-fast article)) (marks (when id (gnus-registry-get-id-key id 'mark)))) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index e222d24b694..5b746a8efa9 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -137,6 +137,8 @@ It accepts the same format specs that `gnus-summary-line-format' does." "Start reading the picked articles. If given a prefix, mark all unpicked articles as read." (interactive "P") + (declare (completion (lambda (s b) + (completion-minor-mode-active-p s b 'gnus-pick-mode)))) (if gnus-newsgroup-processable (progn (gnus-summary-limit-to-articles nil) @@ -462,7 +464,7 @@ Two predefined functions are available: (defun gnus-tree-read-summary-keys (&optional arg) "Read a summary buffer key sequence and execute it." - (interactive "P") + (interactive "P" gnus-tree-mode) (unless gnus-tree-inhibit (let ((buf (current-buffer)) (gnus-tree-inhibit t) @@ -477,7 +479,7 @@ Two predefined functions are available: (defun gnus-tree-show-summary () "Reconfigure windows to show summary buffer." - (interactive) + (interactive nil gnus-tree-mode) (if (not (gnus-buffer-live-p gnus-summary-buffer)) (error "There is no summary buffer for this tree buffer") (gnus-configure-windows 'article) @@ -485,7 +487,7 @@ Two predefined functions are available: (defun gnus-tree-select-article (article) "Select the article under point, if any." - (interactive (list (gnus-tree-article-number))) + (interactive (list (gnus-tree-article-number)) gnus-tree-mode) (let ((buf (current-buffer))) (when article (with-current-buffer gnus-summary-buffer @@ -494,7 +496,7 @@ Two predefined functions are available: (defun gnus-tree-pick-article (e) "Select the article under the mouse pointer." - (interactive "e") + (interactive "e" gnus-tree-mode) (mouse-set-point e) (gnus-tree-select-article (gnus-tree-article-number))) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index ade0897a16a..ce64dcef041 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -528,7 +528,8 @@ permanence, and the string to be used. The numerical prefix will be used as SCORE. A symbolic prefix of `a' (the SYMP parameter) says to use the `all.SCORE' file for the command instead of the current score file." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") + gnus-article-mode gnus-summary-mode) (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp)) (defun gnus-score-kill-help-buffer () @@ -544,7 +545,8 @@ permanence, and the string to be used. The numerical prefix will be used as SCORE. A symbolic prefix of `a' (the SYMP parameter) says to use the `all.SCORE' file for the command instead of the current score file." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") + gnus-article-mode gnus-summary-mode) (let* ((nscore (gnus-score-delta-default score)) (prefix (if (< nscore 0) ?L ?I)) (increase (> nscore 0)) @@ -931,15 +933,16 @@ TYPE is the score type. SCORE is the score to add. EXTRA is the possible non-standard header." (interactive (list (gnus-completing-read "Header" - (mapcar + (mapcar #'car (seq-filter (lambda (x) (fboundp (nth 2 x))) gnus-header-index)) - t) + t) (read-string "Match: ") (if (y-or-n-p "Use regexp match? ") 'r 's) - (string-to-number (read-string "Score: ")))) + (string-to-number (read-string "Score: "))) + gnus-article-mode gnus-summary-mode) (save-excursion (unless (and (stringp match) (> (length match) 0)) (error "No match")) @@ -974,7 +977,8 @@ EXTRA is the possible non-standard header." "Automatically mark articles with score below SCORE as read." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-number (read-string "Mark below: "))))) + (string-to-number (read-string "Mark below: ")))) + gnus-article-mode gnus-summary-mode) (setq score (or score gnus-summary-default-score 0)) (gnus-score-set 'mark (list score)) (gnus-score-set 'touched '(t)) @@ -1008,14 +1012,15 @@ EXTRA is the possible non-standard header." "Automatically expunge articles with score below SCORE." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-number (read-string "Set expunge below: "))))) + (string-to-number (read-string "Set expunge below: ")))) + gnus-article-mode gnus-summary-mode) (setq score (or score gnus-summary-default-score 0)) (gnus-score-set 'expunge (list score)) (gnus-score-set 'touched '(t))) (defun gnus-score-followup-article (&optional score) "Add SCORE to all followups to the article in the current buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (setq score (gnus-score-delta-default score)) (when (gnus-buffer-live-p gnus-summary-buffer) (save-excursion @@ -1030,7 +1035,7 @@ EXTRA is the possible non-standard header." (defun gnus-score-followup-thread (&optional score) "Add SCORE to all later articles in the thread the current buffer is part of." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (setq score (gnus-score-delta-default score)) (when (gnus-buffer-live-p gnus-summary-buffer) (save-excursion @@ -1064,13 +1069,13 @@ EXTRA is the possible non-standard header." (defun gnus-summary-raise-score (n) "Raise the score of the current article by N." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-summary-set-score (+ (gnus-summary-article-score) (or n gnus-score-interactive-default-score )))) (defun gnus-summary-set-score (n) "Set the score of the current article to N." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (save-excursion (gnus-summary-show-thread) (let ((buffer-read-only nil)) @@ -1089,7 +1094,7 @@ EXTRA is the possible non-standard header." (defun gnus-summary-current-score (arg) "Return the score of the current article. With prefix ARG, return the total score of the current (sub)thread." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (message "%s" (if arg (gnus-thread-total-score (gnus-id-to-thread @@ -1099,14 +1104,16 @@ EXTRA is the possible non-standard header." (defun gnus-score-change-score-file (file) "Change current score alist." (interactive - (list (read-file-name "Change to score file: " gnus-kill-files-directory))) + (list (read-file-name "Change to score file: " gnus-kill-files-directory)) + gnus-article-mode gnus-summary-mode) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) (defvar gnus-score-edit-exit-function) (defun gnus-score-edit-current-scores (file) "Edit the current score alist." - (interactive (list gnus-current-score-file)) + (interactive (list gnus-current-score-file) + gnus-article-mode gnus-summary-mode) (if (not gnus-current-score-file) (error "No current score file") (let ((winconf (current-window-configuration))) @@ -2496,7 +2503,7 @@ score in `gnus-newsgroup-scored' by SCORE." (defun gnus-score-find-trace () "Find all score rules that applies to the current article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((old-scored gnus-newsgroup-scored)) (let ((gnus-newsgroup-headers (list (gnus-summary-article-header))) @@ -2611,7 +2618,7 @@ the score file and its full name, including the directory.") (defun gnus-summary-rescore () "Redo the entire scoring process in the current summary." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-score-save) (setq gnus-score-cache nil) (setq gnus-newsgroup-scored nil) @@ -2642,7 +2649,7 @@ the score file and its full name, including the directory.") (defun gnus-summary-raise-same-subject-and-select (score) "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (let ((subject (gnus-summary-article-subject))) (gnus-summary-raise-score score) (while (gnus-summary-find-subject subject) @@ -2651,7 +2658,7 @@ the score file and its full name, including the directory.") (defun gnus-summary-raise-same-subject (score) "Raise articles which has the same subject with SCORE." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (let ((subject (gnus-summary-article-subject))) (gnus-summary-raise-score score) (while (gnus-summary-find-subject subject) @@ -2664,7 +2671,7 @@ the score file and its full name, including the directory.") (defun gnus-summary-raise-thread (&optional score) "Raise the score of the articles in the current thread with SCORE." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (setq score (gnus-score-delta-default score)) (let (e) (save-excursion @@ -2683,17 +2690,17 @@ the score file and its full name, including the directory.") (defun gnus-summary-lower-same-subject-and-select (score) "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-summary-raise-same-subject-and-select (- score))) (defun gnus-summary-lower-same-subject (score) "Raise articles which has the same subject with SCORE." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-summary-raise-same-subject (- score))) (defun gnus-summary-lower-thread (&optional score) "Lower score of articles in the current thread with SCORE." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-summary-raise-thread (- (gnus-score-delta-default score)))) ;;; Finding score files. diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el index 5dcd079fb48..eeedf7ff35c 100644 --- a/lisp/gnus/gnus-sieve.el +++ b/lisp/gnus/gnus-sieve.el @@ -113,7 +113,7 @@ Return nil if no rule could be guessed." ;;;###autoload (defun gnus-sieve-article-add-rule () - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-summary-select-article nil 'force) (with-current-buffer gnus-original-article-buffer (let ((rule (gnus-sieve-guess-rule-for-article)) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index a305e343f69..f66f8427eab 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -409,7 +409,7 @@ The following commands are available: (defun gnus-server-kill-server (server) "Kill the server on the current line." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (unless (gnus-server-goto-server server) (if server (error "No such server: %s" server) (error "No server on the current line"))) @@ -438,7 +438,7 @@ The following commands are available: (defun gnus-server-yank-server () "Yank the previously killed server." - (interactive) + (interactive nil gnus-server-mode) (unless gnus-server-killed-servers (error "No killed servers to be yanked")) (let ((alist gnus-server-alist) @@ -460,14 +460,14 @@ The following commands are available: (defun gnus-server-exit () "Return to the group buffer." - (interactive) + (interactive nil gnus-server-mode) (gnus-run-hooks 'gnus-server-exit-hook) (gnus-kill-buffer (current-buffer)) (gnus-configure-windows 'group t)) (defun gnus-server-list-servers () "List all available servers." - (interactive) + (interactive nil gnus-server-mode) (let ((cur (gnus-server-server-name))) (gnus-server-prepare) (if cur (gnus-server-goto-server cur) @@ -489,7 +489,7 @@ The following commands are available: (defun gnus-server-open-server (server) "Force an open of SERVER." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (unless method (error "No such server: %s" server)) @@ -501,13 +501,13 @@ The following commands are available: (defun gnus-server-open-all-servers () "Open all servers." - (interactive) + (interactive nil gnus-server-mode) (dolist (server gnus-inserted-opened-servers) (gnus-server-open-server (car server)))) (defun gnus-server-close-server (server) "Close SERVER." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (unless method (error "No such server: %s" server)) @@ -519,7 +519,7 @@ The following commands are available: (defun gnus-server-offline-server (server) "Set SERVER to offline." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (unless method (error "No such server: %s" server)) @@ -531,7 +531,7 @@ The following commands are available: (defun gnus-server-close-all-servers () "Close all servers." - (interactive) + (interactive nil gnus-server-mode) (dolist (server gnus-inserted-opened-servers) (gnus-server-close-server (car server))) (dolist (server gnus-server-alist) @@ -539,7 +539,7 @@ The following commands are available: (defun gnus-server-deny-server (server) "Make sure SERVER will never be attempted opened." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (unless method (error "No such server: %s" server)) @@ -550,7 +550,7 @@ The following commands are available: (defun gnus-server-remove-denials () "Make all denied servers into closed servers." - (interactive) + (interactive nil gnus-server-mode) (dolist (server gnus-opened-servers) (when (eq (nth 1 server) 'denied) (setcar (nthcdr 1 server) 'closed))) @@ -558,11 +558,11 @@ The following commands are available: (defun gnus-server-copy-server (from to) "Copy a server definition to a new name." - (interactive - (list - (or (gnus-server-server-name) - (error "No server on the current line")) - (read-string "Copy to: "))) + (interactive (list + (or (gnus-server-server-name) + (error "No server on the current line")) + (read-string "Copy to: ")) + gnus-server-mode) (unless from (error "No server on current line")) (unless (and to (not (string= to ""))) @@ -583,7 +583,8 @@ The following commands are available: (list (intern (gnus-completing-read "Server method" (mapcar #'car gnus-valid-select-methods) t)) - (read-string "Server name: "))) + (read-string "Server name: ")) + gnus-server-mode) (when (assq where gnus-server-alist) (error "Server with that name already defined")) (push (list where how where) gnus-server-killed-servers) @@ -593,7 +594,8 @@ The following commands are available: "Jump to a server line." (interactive (list (gnus-completing-read "Goto server" - (mapcar #'car gnus-server-alist) t))) + (mapcar #'car gnus-server-alist) t)) + gnus-server-mode) (let ((to (text-property-any (point-min) (point-max) 'gnus-server (intern server)))) (when to @@ -602,7 +604,7 @@ The following commands are available: (defun gnus-server-edit-server (server) "Edit the server on the current line." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (unless server (error "No server on current line")) (unless (assoc server gnus-server-alist) @@ -620,7 +622,7 @@ The following commands are available: (defun gnus-server-show-server (server) "Show the definition of the server on the current line." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (unless server (error "No server on current line")) (let ((info (gnus-server-to-method server))) @@ -632,7 +634,7 @@ The following commands are available: (defun gnus-server-scan-server (server) "Request a scan from the current server." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (if (not (gnus-get-function method 'request-scan)) (error "Server %s can't scan" (car method)) @@ -897,7 +899,7 @@ buffer. (defun gnus-browse-read-group (&optional no-article number) "Enter the group at the current line. If NUMBER, fetch this number of articles." - (interactive "P") + (interactive "P" gnus-browse-mode) (let* ((full-name (gnus-browse-group-name)) (group (if (gnus-native-method-p (gnus-find-method-for-group full-name)) @@ -916,26 +918,26 @@ If NUMBER, fetch this number of articles." (defun gnus-browse-select-group (&optional number) "Select the current group. If NUMBER, fetch this number of articles." - (interactive "P") + (interactive "P" gnus-browse-mode) (gnus-browse-read-group 'no number)) (defun gnus-browse-next-group (n) "Go to the next group." - (interactive "p") + (interactive "p" gnus-browse-mode) (prog1 (forward-line n) (gnus-group-position-point))) (defun gnus-browse-prev-group (n) "Go to the next group." - (interactive "p") + (interactive "p" gnus-browse-mode) (gnus-browse-next-group (- n))) (defun gnus-browse-unsubscribe-current-group (arg) "(Un)subscribe to the next ARG groups. The variable `gnus-browse-subscribe-newsgroup-method' determines how new groups will be entered into the group buffer." - (interactive "p") + (interactive "p" gnus-browse-mode) (when (eobp) (error "No group at current line")) (let ((ward (if (< arg 0) -1 1)) @@ -961,7 +963,7 @@ how new groups will be entered into the group buffer." (defun gnus-browse-describe-group (group) "Describe the current group." - (interactive (list (gnus-browse-group-name))) + (interactive (list (gnus-browse-group-name)) gnus-browse-mode) (gnus-group-describe-group nil group)) (defun gnus-browse-delete-group (group force) @@ -970,8 +972,8 @@ If FORCE (the prefix) is non-nil, all the articles in the group will be deleted. This is \"deleted\" as in \"removed forever from the face of the Earth\". There is no undo. The user will be prompted before doing the deletion." - (interactive (list (gnus-browse-group-name) - current-prefix-arg)) + (interactive (list (gnus-browse-group-name) current-prefix-arg) + gnus-browse-mode) (gnus-group-delete-group group force)) (defun gnus-browse-unsubscribe-group () @@ -1020,7 +1022,7 @@ doing the deletion." (defun gnus-browse-exit () "Quit browsing and return to the group buffer." - (interactive) + (interactive nil gnus-browse-mode) (when (derived-mode-p 'gnus-browse-mode) (gnus-kill-buffer (current-buffer))) ;; Insert the newly subscribed groups in the group buffer. @@ -1032,7 +1034,7 @@ doing the deletion." (defun gnus-browse-describe-briefly () "Give a one line description of the group mode commands." - (interactive) + (interactive nil gnus-browse-mode) (gnus-message 6 "%s" (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) @@ -1089,7 +1091,7 @@ Requesting compaction of %s... (this may take a long time)" (defun gnus-server-toggle-cloud-server () "Toggle whether the server under point is replicated in the Emacs Cloud." - (interactive) + (interactive nil gnus-server-mode) (let ((server (gnus-server-server-name))) (unless server (error "No server on the current line")) @@ -1110,7 +1112,7 @@ Requesting compaction of %s... (this may take a long time)" (defun gnus-server-set-cloud-method-server () "Set the server under point to host the Emacs Cloud." - (interactive) + (interactive nil gnus-server-mode) (let ((server (gnus-server-server-name))) (unless server (error "No server on the current line")) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 1554635a3f2..a3112bdd9fe 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1070,7 +1070,7 @@ With 1 C-u, use the `ask-server' method to query the server for new groups. With 2 C-u's, use most complete method possible to query the server for new groups, and subscribe the new groups as zombies." - (interactive "p") + (interactive "p" gnus-group-mode) (let* ((gnus-subscribe-newsgroup-method gnus-subscribe-newsgroup-method) (check (cond @@ -1405,7 +1405,7 @@ newsgroup." (defun gnus-check-duplicate-killed-groups () "Remove duplicates from the list of killed groups." - (interactive) + (interactive nil gnus-group-mode) (let ((killed gnus-killed-list)) (while killed (gnus-message 9 "%d" (length killed)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 456e7b0f8c4..4065cf08342 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -73,18 +73,10 @@ (eval-when-compile (require 'subr-x)) -(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) +(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil + '(gnus-summary-mode)) (autoload 'gnus-cache-write-active "gnus-cache") -(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) -(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) (autoload 'gnus-pick-line-number "gnus-salt" nil t) -(autoload 'mm-uu-dissect "mm-uu") -(autoload 'gnus-article-outlook-deuglify-article "deuglify" - "Deuglify broken Outlook (Express) articles and redisplay." - t) -(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t) -(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t) -(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t) (autoload 'nnselect-article-rsv "nnselect" nil nil) (autoload 'nnselect-article-group "nnselect" nil nil) (autoload 'gnus-nnselect-group-p "nnselect" nil nil) @@ -2525,6 +2517,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (let ((gnus-summary-show-article-charset-alist `((1 . ,cs)))) (gnus-summary-show-article 1)))) + (put command 'completion-predicate 'ignore) `[,(symbol-name cs) ,command t])) (sort (coding-system-list) #'string<))))) ("Washing" @@ -3149,6 +3142,7 @@ buffer; read the Info manual for more information (`\\[gnus-info-find-node]'). The following commands are available: \\{gnus-summary-mode-map}" + :interactive nil (let ((gnus-summary-local-variables gnus-newsgroup-variables)) (gnus-summary-make-local-variables)) (gnus-summary-make-local-variables) @@ -3479,7 +3473,7 @@ marks of articles." ;; Various summary mode internalish functions. (defun gnus-mouse-pick-article (e) - (interactive "e") + (interactive "e" gnus-summary-mode) (mouse-set-point e) (gnus-summary-next-page nil t)) @@ -4219,7 +4213,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (defun gnus-summary-prepare () "Generate the summary buffer." - (interactive) + (interactive nil gnus-summary-mode) (let ((inhibit-read-only t)) (erase-buffer) (setq gnus-newsgroup-data nil @@ -4268,7 +4262,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (defun gnus-summary-simplify-subject-query () "Query where the respool algorithm would put this article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (message "%s" (gnus-general-simplify-subject (gnus-summary-article-subject)))) @@ -6671,19 +6665,19 @@ executed with point over the summary line of the articles." (defun gnus-summary-save-process-mark () "Push the current set of process marked articles on the stack." - (interactive) + (interactive nil gnus-summary-mode) (push (copy-sequence gnus-newsgroup-processable) gnus-newsgroup-process-stack)) (defun gnus-summary-kill-process-mark () "Push the current set of process marked articles on the stack and unmark." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-save-process-mark) (gnus-summary-unmark-all-processable)) (defun gnus-summary-yank-process-mark () "Pop the last process mark state off the stack and restore it." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-newsgroup-process-stack (error "Empty mark stack")) (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack))) @@ -6818,7 +6812,7 @@ articles with that subject. If BACKWARD, search backward instead." (defun gnus-recenter (&optional n) "Center point in window and redisplay frame. Also do horizontal recentering." - (interactive "P") + (interactive "P" gnus-summary-mode) (when (and gnus-auto-center-summary (not (eq gnus-auto-center-summary 'vertical))) (gnus-horizontal-recenter)) @@ -6852,7 +6846,7 @@ If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - (interactive) + (interactive nil gnus-summary-mode) ;; The user has to want it. (when gnus-auto-center-summary (let* ((top (cond ((< (window-height) 4) 0) @@ -7029,7 +7023,7 @@ displayed, no centering will be performed." "Reconfigure windows to show the article buffer. If `gnus-widen-article-window' is set, show only the article buffer." - (interactive) + (interactive nil gnus-summary-mode) (if (not (gnus-buffer-live-p gnus-article-buffer)) (error "There is no article buffer for this summary buffer") (or (get-buffer-window gnus-article-buffer) @@ -7052,7 +7046,7 @@ buffer." (defun gnus-summary-universal-argument (arg) "Perform any operation on all articles that are process/prefixed." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((articles (gnus-summary-work-articles arg)) func article) (if (eq @@ -7073,7 +7067,7 @@ buffer." (gnus-summary-position-point)) (define-obsolete-function-alias - 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1") + 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1") (defun gnus-summary-find-for-reselect () "Return the number of an article to stay on across a reselect. @@ -7095,7 +7089,7 @@ insertion from another group. If there's no such then return a dummy 0." (defun gnus-summary-reselect-current-group (&optional all rescan) "Exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (when (gnus-ephemeral-group-p gnus-newsgroup-name) (error "Ephemeral groups can't be reselected")) (let ((current-subject (gnus-summary-find-for-reselect)) @@ -7113,7 +7107,7 @@ The prefix argument ALL means to select all articles." (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((config gnus-current-window-configuration)) (gnus-summary-reselect-current-group all t) (gnus-configure-windows config) @@ -7168,7 +7162,7 @@ The prefix argument ALL means to select all articles." (defun gnus-summary-make-group-from-search () "Make a persistent group from the current ephemeral search group." - (interactive) + (interactive nil gnus-summary-mode) (if (not (gnus-nnselect-group-p gnus-newsgroup-name)) (gnus-message 3 "%s is not a search group" gnus-newsgroup-name) (let ((name (gnus-read-group "Group name: "))) @@ -7185,7 +7179,7 @@ The prefix argument ALL means to select all articles." "Save the current number of read/marked articles in the dribble buffer. The dribble buffer will then be saved. If FORCE (the prefix), also save the .newsrc file(s)." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-update-info t) (if force (gnus-save-newsrc-file) @@ -7197,7 +7191,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defun gnus-summary-exit (&optional temporary leave-hidden) "Exit reading current newsgroup, and then return to group selection mode. `gnus-exit-group-hook' is called with no arguments if that value is non-nil." - (interactive) + (interactive nil gnus-summary-mode) (gnus-set-global-variables) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer @@ -7303,7 +7297,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) (defun gnus-summary-exit-no-update (&optional no-questions) "Quit reading current newsgroup without updating read article info." - (interactive) + (interactive nil gnus-summary-mode) (let* ((group gnus-newsgroup-name) (gnus-group-is-exiting-p t) (gnus-group-is-exiting-without-update-p t) @@ -7457,7 +7451,7 @@ The state which existed when entering the ephemeral is reset." (defun gnus-summary-wake-up-the-dead (&rest _) "Wake up the dead summary buffer." - (interactive) + (interactive nil gnus-summary-mode) (gnus-dead-summary-mode -1) (let ((name (buffer-name))) (when (string-match "Dead " name) @@ -7470,12 +7464,12 @@ The state which existed when entering the ephemeral is reset." ;; Suggested by Per Abrahamsen . (defun gnus-summary-describe-group (&optional force) "Describe the current newsgroup." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-group-describe-group force gnus-newsgroup-name)) (defun gnus-summary-describe-briefly () "Describe summary mode commands briefly." - (interactive) + (interactive nil gnus-summary-mode) (gnus-message 6 "%s" (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) ;; Walking around group mode buffer from summary mode. @@ -7485,7 +7479,7 @@ The state which existed when entering the ephemeral is reset." If prefix argument NO-ARTICLE is non-nil, no article is selected initially. If TARGET-GROUP, go to this group. If BACKWARD, go to previous group instead." - (interactive "P") + (interactive "P" gnus-summary-mode) ;; Stop pre-fetching. (gnus-async-halt-prefetch) (let ((current-group gnus-newsgroup-name) @@ -7531,7 +7525,7 @@ previous group instead." (defun gnus-summary-prev-group (&optional no-article) "Exit current newsgroup and then select previous unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-next-group no-article nil t)) ;; Walking around summary lines. @@ -7542,7 +7536,7 @@ If UNREAD is non-nil, the article should be unread. If UNDOWNLOADED is non-nil, the article should be undownloaded. If UNSEEN is non-nil, the article should be unseen as well as unread. Returns the article selected or nil if there are no matching articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (cond ;; Empty summary. ((null gnus-newsgroup-data) @@ -7594,7 +7588,7 @@ If N is negative, go to the previous N'th subject line. If UNREAD is non-nil, only unread articles are selected. The difference between N and the actual number of steps taken is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) @@ -7613,18 +7607,18 @@ returned." (defun gnus-summary-next-unread-subject (n) "Go to next N'th unread summary line." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-next-subject n t)) (defun gnus-summary-prev-subject (n &optional unread) "Go to previous N'th summary line. If optional argument UNREAD is non-nil, only unread article is selected." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-next-subject (- n) unread)) (defun gnus-summary-prev-unread-subject (n) "Go to previous N'th unread summary line." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-next-subject (- n) t)) (defun gnus-summary-goto-subjects (articles) @@ -7638,7 +7632,7 @@ If optional argument UNREAD is non-nil, only unread article is selected." (defun gnus-summary-goto-subject (article &optional force silent) "Go to the subject line of ARTICLE. If FORCE, also allow jumping to articles not currently shown." - (interactive "nArticle number: ") + (interactive "nArticle number: " gnus-summary-mode) (unless (numberp article) (error "Article %s is not a number" article)) (let ((b (point)) @@ -7668,7 +7662,7 @@ If FORCE, also allow jumping to articles not currently shown." (defun gnus-summary-expand-window (&optional arg) "Make the summary buffer take up the entire Emacs frame. Given a prefix, will force an `article' buffer configuration." - (interactive "P") + (interactive "P" gnus-summary-mode) (if arg (gnus-configure-windows 'article 'force) (gnus-configure-windows 'summary 'force))) @@ -7751,7 +7745,7 @@ be displayed." (defun gnus-summary-force-verify-and-decrypt () "Display buttons for signed/encrypted parts and verify/decrypt them." - (interactive) + (interactive nil gnus-summary-mode) (let ((mm-verify-option 'known) (mm-decrypt-option 'known) (gnus-article-emulate-mime t) @@ -7765,7 +7759,7 @@ be displayed." If UNREAD, only unread articles are selected. If SUBJECT, only articles with SUBJECT are selected. If BACKWARD, the previous article is selected instead of the next." - (interactive "P") + (interactive "P" gnus-summary-mode) ;; Make sure we are in the summary buffer. (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) @@ -7877,7 +7871,7 @@ If BACKWARD, the previous article is selected instead of the next." (defun gnus-summary-next-unread-article () "Select unread article after current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-next-article (or (not (eq gnus-summary-goto-unread 'never)) (gnus-summary-last-article-p (gnus-summary-article-number))) @@ -7887,12 +7881,12 @@ If BACKWARD, the previous article is selected instead of the next." (defun gnus-summary-prev-article (&optional unread subject) "Select the article before the current one. If UNREAD is non-nil, only unread articles are selected." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-next-article unread subject t)) (defun gnus-summary-prev-unread-article () "Select unread article before current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-prev-article (or (not (eq gnus-summary-goto-unread 'never)) (gnus-summary-first-article-p (gnus-summary-article-number))) @@ -7913,7 +7907,7 @@ article. If STOP is non-nil, just stop when reaching the end of the message. Also see the variable `gnus-article-skip-boring'." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-set-global-variables) (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) @@ -7958,7 +7952,7 @@ Also see the variable `gnus-article-skip-boring'." Argument LINES specifies lines to be scrolled down. If MOVE, move to the previous unread article if point is at the beginning of the buffer." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) endp) @@ -7988,14 +7982,14 @@ the beginning of the buffer." "Show previous page of selected article. Argument LINES specifies lines to be scrolled down. If at the beginning of the article, go to the next article." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-prev-page lines t)) (defun gnus-summary-scroll-up (lines) "Scroll up (or down) one line current article. Argument LINES specifies lines to be scrolled up (or down if negative). If no article is selected, then the current article will be selected first." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-configure-windows 'article) (gnus-summary-show-thread) (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) @@ -8012,33 +8006,33 @@ If no article is selected, then the current article will be selected first." "Scroll down (or up) one line current article. Argument LINES specifies lines to be scrolled down (or up if negative). If no article is selected, then the current article will be selected first." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-scroll-up (- lines))) (defun gnus-summary-next-same-subject () "Select next article which has the same subject as current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-next-article nil (gnus-summary-article-subject))) (defun gnus-summary-prev-same-subject () "Select previous article which has the same subject as current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-prev-article nil (gnus-summary-article-subject))) (defun gnus-summary-next-unread-same-subject () "Select next unread article which has the same subject as current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-next-article t (gnus-summary-article-subject))) (defun gnus-summary-prev-unread-same-subject () "Select previous unread article which has the same subject as current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-prev-article t (gnus-summary-article-subject))) (defun gnus-summary-first-unread-article () "Select the first unread article. Return nil if there are no unread articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when (gnus-summary-first-subject t) (gnus-summary-show-thread) @@ -8049,7 +8043,7 @@ Return nil if there are no unread articles." (defun gnus-summary-first-unread-subject () "Place the point on the subject line of the first unread article. Return nil if there are no unread articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when (gnus-summary-first-subject t) (gnus-summary-show-thread) @@ -8058,7 +8052,7 @@ Return nil if there are no unread articles." (defun gnus-summary-next-unseen-article (&optional backward) "Select the next unseen article." - (interactive) + (interactive nil gnus-summary-mode) (let* ((article (gnus-summary-article-number)) (articles (gnus-data-find-list article (gnus-data-list backward)))) (when (or (not gnus-summary-check-current) @@ -8079,13 +8073,13 @@ Return nil if there are no unread articles." (defun gnus-summary-prev-unseen-article () "Select the previous unseen article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-next-unseen-article t)) (defun gnus-summary-first-unseen-subject () "Place the point on the subject line of the first unseen article. Return nil if there are no unseen articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when (gnus-summary-first-subject nil nil t) (gnus-summary-show-thread) @@ -8096,7 +8090,7 @@ Return nil if there are no unseen articles." "Place the point on the subject line of the first unseen and unread article. If all article have been seen, on the subject line of the first unread article." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (unless (when (gnus-summary-first-subject nil nil t) (gnus-summary-show-thread) @@ -8109,7 +8103,7 @@ article." (defun gnus-summary-first-article () "Select the first article. Return nil if there are no articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when (gnus-summary-first-subject) (gnus-summary-show-thread) @@ -8121,7 +8115,7 @@ Return nil if there are no articles." "Select the unread article with the highest score. If given a prefix argument, select the next unread article that has a score higher than the default score." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((article (if arg (gnus-summary-better-unread-subject) (gnus-summary-best-unread-subject)))) @@ -8131,7 +8125,7 @@ score higher than the default score." (defun gnus-summary-best-unread-subject () "Select the unread subject with the highest score." - (interactive) + (interactive nil gnus-summary-mode) (let ((best -1000000) (data gnus-newsgroup-data) article score) @@ -8150,7 +8144,7 @@ score higher than the default score." (defun gnus-summary-better-unread-subject () "Select the first unread subject that has a score over the default score." - (interactive) + (interactive nil gnus-summary-mode) (let ((data gnus-newsgroup-data) article) (while (and (setq article (gnus-data-number (car data))) @@ -8176,11 +8170,10 @@ If FORCE, go to the article even if it isn't displayed. If FORCE is a number, it is the line the article is to be displayed on." (interactive (list - (gnus-completing-read - "Article number or Message-ID" - (mapcar #'int-to-string gnus-newsgroup-limit)) - current-prefix-arg - t)) + (gnus-completing-read "Article number or Message-ID" + (mapcar #'int-to-string gnus-newsgroup-limit)) + current-prefix-arg t) + gnus-summary-mode) (prog1 (if (and (stringp article) (string-match "@\\|%40" article)) @@ -8194,7 +8187,7 @@ is a number, it is the line the article is to be displayed on." (defun gnus-summary-goto-last-article () "Go to the previously read article." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when gnus-last-article (gnus-summary-goto-article gnus-last-article nil t)) @@ -8203,7 +8196,7 @@ is a number, it is the line the article is to be displayed on." (defun gnus-summary-pop-article (number) "Pop one article off the history and go to the previous. NUMBER articles will be popped off." - (interactive "p") + (interactive "p" gnus-summary-mode) (let (to) (setq gnus-newsgroup-history (cdr (setq to (nthcdr number gnus-newsgroup-history)))) @@ -8217,7 +8210,7 @@ NUMBER articles will be popped off." (defun gnus-summary-limit-to-articles (n) "Limit the summary buffer to the next N articles. If not given a prefix, use the process marked articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (prog1 (let ((articles (gnus-summary-work-articles n))) (setq gnus-newsgroup-processable nil) @@ -8227,7 +8220,7 @@ If not given a prefix, use the process marked articles instead." (defun gnus-summary-pop-limit (&optional total) "Restore the previous limit. If given a prefix, remove all limits." - (interactive "P") + (interactive "P" gnus-summary-mode) (when total (setq gnus-newsgroup-limits (list (mapcar #'mail-header-number gnus-newsgroup-headers)))) @@ -8241,10 +8234,11 @@ If given a prefix, remove all limits." "Limit the summary buffer to articles that have subjects that match a regexp. If NOT-MATCHING, excluding articles that have subjects that match a regexp." (interactive - (list (read-string (if current-prefix-arg - "Exclude subject (regexp): " - "Limit to subject (regexp): ")) - nil current-prefix-arg)) + (list + (read-string + (if current-prefix-arg "Exclude subject (regexp): " "Limit to subject (regexp): ")) + nil current-prefix-arg) + gnus-summary-mode) (unless header (setq header "subject")) (when (not (equal "" subject)) @@ -8261,18 +8255,25 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp." "Limit the summary buffer to articles that have authors that match a regexp. If NOT-MATCHING, excluding articles that have authors that match a regexp." (interactive - (list (let* ((header (gnus-summary-article-header)) - (default (and header (car (mail-header-parse-address - (mail-header-from header)))))) - (read-string (concat (if current-prefix-arg - "Exclude author (regexp" - "Limit to author (regexp") - (if default - (concat ", default \"" default "\"): ") - "): ")) - nil nil - default)) - current-prefix-arg)) + (list + (let* + ((header + (gnus-summary-article-header)) + (default + (and header + (car + (mail-header-parse-address + (mail-header-from header)))))) + (read-string + (concat + (if current-prefix-arg + "Exclude author (regexp" "Limit to author (regexp") + (if default + (concat ", default \"" default "\"): ") + "): ")) + nil nil default)) + current-prefix-arg) + gnus-summary-mode) (gnus-summary-limit-to-subject from "from" not-matching)) (defun gnus-summary-limit-to-recipient (recipient &optional not-matching) @@ -8284,9 +8285,12 @@ To and Cc headers are checked. You need to include them in `nnmail-extra-headers'." ;; Unlike `rmail-summary-by-recipients', doesn't include From. (interactive - (list (read-string (format "%s recipient (regexp): " - (if current-prefix-arg "Exclude" "Limit to"))) - current-prefix-arg)) + (list + (read-string + (format "%s recipient (regexp): " + (if current-prefix-arg "Exclude" "Limit to"))) + current-prefix-arg) + gnus-summary-mode) (when (not (equal "" recipient)) (prog1 (let* ((to (if (memq 'To nnmail-extra-headers) @@ -8326,9 +8330,12 @@ If NOT-MATCHING, exclude ADDRESS. To, Cc and From headers are checked. You need to include `To' and `Cc' in `nnmail-extra-headers'." (interactive - (list (read-string (format "%s address (regexp): " - (if current-prefix-arg "Exclude" "Limit to"))) - current-prefix-arg)) + (list + (read-string + (format "%s address (regexp): " + (if current-prefix-arg "Exclude" "Limit to"))) + current-prefix-arg) + gnus-summary-mode) (when (not (equal "" address)) (prog1 (let* ((to (if (memq 'To nnmail-extra-headers) @@ -8415,7 +8422,8 @@ articles that are younger than AGE days." (setq days (* days -1)))) (message "Please enter a number.") (sleep-for 1))) - (list days younger))) + (list days younger)) + gnus-summary-mode) (prog1 (let ((data gnus-newsgroup-data) (cutoff (days-to-time age)) @@ -8439,17 +8447,18 @@ articles that are younger than AGE days." (let ((header (intern (gnus-completing-read - (if current-prefix-arg - "Exclude extra header" - "Limit extra header") + (if current-prefix-arg "Exclude extra header" "Limit extra header") (mapcar #'symbol-name gnus-extra-headers) t nil nil - (symbol-name (car gnus-extra-headers)))))) + (symbol-name + (car gnus-extra-headers)))))) (list header - (read-string (format "%s header %s (regexp): " - (if current-prefix-arg "Exclude" "Limit to") - header)) - current-prefix-arg))) + (read-string + (format "%s header %s (regexp): " + (if current-prefix-arg "Exclude" "Limit to") + header)) + current-prefix-arg)) + gnus-summary-mode) (when (not (equal "" regexp)) (prog1 (let ((articles (gnus-summary-find-matching @@ -8462,7 +8471,7 @@ articles that are younger than AGE days." (defun gnus-summary-limit-to-display-predicate () "Limit the summary buffer to the predicated in the `display' group parameter." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-newsgroup-display (error "There is no `display' group parameter")) (let (articles) @@ -8475,7 +8484,7 @@ articles that are younger than AGE days." (defun gnus-summary-limit-to-unread (&optional all) "Limit the summary buffer to articles that are not marked as read. If ALL is non-nil, limit strictly to unread articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (if all (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) (gnus-summary-limit-to-marks @@ -8491,7 +8500,7 @@ If ALL is non-nil, limit strictly to unread articles." (defun gnus-summary-limit-to-headers (match &optional reverse) "Limit the summary buffer to articles that have headers that match MATCH. If REVERSE (the prefix), limit to articles that don't match." - (interactive "sMatch headers (regexp): \nP") + (interactive "sMatch headers (regexp): \nP" gnus-summary-mode) (gnus-summary-limit-to-bodies match reverse t)) (declare-function article-goto-body "gnus-art" ()) @@ -8499,7 +8508,7 @@ If REVERSE (the prefix), limit to articles that don't match." (defun gnus-summary-limit-to-bodies (match &optional reverse headersp) "Limit the summary buffer to articles that have bodies that match MATCH. If REVERSE (the prefix), limit to articles that don't match." - (interactive "sMatch body (regexp): \nP") + (interactive "sMatch body (regexp): \nP" gnus-summary-mode) (let ((articles nil) (gnus-select-article-hook nil) ;Disable hook. (gnus-article-prepare-hook nil) @@ -8532,7 +8541,7 @@ If REVERSE (the prefix), limit to articles that don't match." (defun gnus-summary-limit-to-singletons (&optional threadsp) "Limit the summary buffer to articles that aren't part on any thread. If THREADSP (the prefix), limit to articles that are in threads." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((articles nil) thread-articles threads) @@ -8556,7 +8565,7 @@ If THREADSP (the prefix), limit to articles that are in threads." (defun gnus-summary-limit-to-replied (&optional unreplied) "Limit the summary buffer to replied articles. If UNREPLIED (the prefix), limit to unreplied articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (if unreplied (gnus-summary-limit (gnus-set-difference gnus-newsgroup-articles @@ -8569,7 +8578,7 @@ If UNREPLIED (the prefix), limit to unreplied articles." If REVERSE, limit the summary buffer to articles that are marked with MARKS. MARKS can either be a string of marks or a list of marks. Returns how many articles were removed." - (interactive "sMarks: ") + (interactive "sMarks: " gnus-summary-mode) (gnus-summary-limit-to-marks marks t)) (defun gnus-summary-limit-to-marks (marks &optional reverse) @@ -8578,7 +8587,7 @@ If REVERSE (the prefix), limit the summary buffer to articles that are not marked with MARKS. MARKS can either be a string of marks or a list of marks. Returns how many articles were removed." - (interactive "sMarks: \nP") + (interactive "sMarks: \nP" gnus-summary-mode) (prog1 (let ((data gnus-newsgroup-data) (marks (if (listp marks) marks @@ -8597,10 +8606,13 @@ Returns how many articles were removed." With a prefix argument, limit to articles with score at or below SCORE." - (interactive (list (string-to-number - (read-string - (format "Limit to articles with score of at %s: " - (if current-prefix-arg "most" "least")))))) + (interactive + (list + (string-to-number + (read-string + (format "Limit to articles with score of at %s: " + (if current-prefix-arg "most" "least"))))) + gnus-summary-mode) (let ((data gnus-newsgroup-data) (compare (if (or below current-prefix-arg) #'<= #'>=)) articles) @@ -8616,7 +8628,7 @@ SCORE." (defun gnus-summary-limit-to-unseen () "Limit to unseen articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (gnus-summary-limit gnus-newsgroup-unseen) (gnus-summary-position-point))) @@ -8626,8 +8638,12 @@ SCORE." When called interactively, ID is the Message-ID of the current article. If thread-only is non-nil limit the summary buffer to these articles." - (interactive (list (mail-header-id (gnus-summary-article-header)) - current-prefix-arg)) + (interactive + (list + (mail-header-id + (gnus-summary-article-header)) + current-prefix-arg) + gnus-summary-mode) (let ((articles (gnus-articles-in-thread (gnus-id-to-thread (gnus-root-id id)))) ;;we REALLY want the whole thread---this prevents cut-threads @@ -8653,8 +8669,11 @@ these articles." (defun gnus-summary-limit-include-matching-articles (header regexp) "Display all the hidden articles that have HEADERs that match REGEXP." - (interactive (list (read-string "Match on header: ") - (read-string "Regexp: "))) + (interactive + (list + (read-string "Match on header: ") + (read-string "Regexp: ")) + gnus-summary-mode) (let ((articles (gnus-find-matching-articles header regexp))) (prog1 (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) @@ -8662,7 +8681,7 @@ these articles." (defun gnus-summary-insert-dormant-articles () "Insert all the dormant articles for this group into the current buffer." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-verbose (max 6 gnus-verbose))) (if (not gnus-newsgroup-dormant) (gnus-message 3 "No dormant articles for this group") @@ -8670,7 +8689,7 @@ these articles." (defun gnus-summary-insert-ticked-articles () "Insert ticked articles for this group into the current buffer." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-verbose (max 6 gnus-verbose))) (if (not gnus-newsgroup-marked) (gnus-message 3 "No ticked articles for this group") @@ -8680,7 +8699,7 @@ these articles." "Display all the hidden articles that are marked as dormant. Note that this command only works on a subset of the articles currently fetched for this group." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-newsgroup-dormant (error "There are no dormant articles in this group")) (prog1 @@ -8703,14 +8722,14 @@ fetched for this group." (defun gnus-summary-limit-exclude-dormant () "Hide all dormant articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) (gnus-summary-position-point))) (defun gnus-summary-limit-exclude-childless-dormant () "Hide all dormant articles that have no children." - (interactive) + (interactive nil gnus-summary-mode) (let ((data (gnus-data-list t)) articles d children) ;; Find all articles that are either not dormant or have @@ -8735,7 +8754,7 @@ fetched for this group." (defun gnus-summary-limit-mark-excluded-as-read (&optional all) "Mark all unread excluded articles as read. If ALL, mark even excluded ticked and dormants as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<)) (let ((articles (gnus-sorted-ndifference (sort @@ -8974,7 +8993,7 @@ fetch-old-headers verbiage, and so on." "Refer parent article N times. If N is negative, go to ancestor -N instead. The difference between N and the number of articles fetched is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (let ((skip 1) error header ref) (when (not (natnump n)) @@ -9016,7 +9035,7 @@ The difference between N and the number of articles fetched is returned." (defun gnus-summary-refer-references () "Fetch all articles mentioned in the References header. Return the number of articles fetched." - (interactive) + (interactive nil gnus-summary-mode) (let ((ref (mail-header-references (gnus-summary-article-header))) (current (gnus-summary-article-number)) (n 0)) @@ -9059,7 +9078,7 @@ has the reverse meaning. If no backend-specific `request-thread' function is available fetch LIMIT (the numerical prefix) old headers. If LIMIT is non-numeric or nil fetch the number specified by the `gnus-refer-thread-limit' variable." - (interactive "P") + (interactive "P" gnus-summary-mode) (let* ((header (gnus-summary-article-header)) (id (mail-header-id header)) (gnus-inhibit-demon t) @@ -9114,7 +9133,7 @@ specified by the `gnus-refer-thread-limit' variable." (defun gnus-summary-open-group-with-article (message-id) "Open a group containing the article with the given MESSAGE-ID." - (interactive "sMessage-ID: ") + (interactive "sMessage-ID: " gnus-summary-mode) (require 'nndoc) (with-temp-buffer ;; Prepare a dummy article @@ -9149,7 +9168,7 @@ specified by the `gnus-refer-thread-limit' variable." (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." - (interactive "sMessage-ID: ") + (interactive "sMessage-ID: " gnus-summary-mode) (when (and (stringp message-id) (not (zerop (length message-id)))) (setq message-id (replace-regexp-in-string " " "" message-id)) @@ -9222,12 +9241,12 @@ specified by the `gnus-refer-thread-limit' variable." (defun gnus-summary-edit-parameters () "Edit the group parameters of the current group." - (interactive) + (interactive nil gnus-summary-mode) (gnus-group-edit-group gnus-newsgroup-name 'params)) (defun gnus-summary-customize-parameters () "Customize the group parameters of the current group." - (interactive) + (interactive nil gnus-summary-mode) (gnus-group-customize gnus-newsgroup-name)) (defun gnus-summary-enter-digest-group (&optional force) @@ -9237,7 +9256,7 @@ what the document format is. To control what happens when you exit the group, see the `gnus-auto-select-on-ephemeral-exit' variable." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((conf gnus-current-window-configuration)) (save-window-excursion (save-excursion @@ -9322,7 +9341,7 @@ To control what happens when you exit the group, see the This will allow you to read digests and other similar documents as newsgroups. Obeys the standard process/prefix convention." - (interactive "P") + (interactive "P" gnus-summary-mode) (let* ((ogroup gnus-newsgroup-name) (params (append (gnus-info-params (gnus-get-info ogroup)) (list (cons 'to-group ogroup)))) @@ -9371,7 +9390,7 @@ Obeys the standard process/prefix convention." (defun gnus-summary-button-forward (arg) "Move point to the next field or button in the article. With optional ARG, move across that many fields." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (let ((win (or (gnus-get-buffer-window gnus-article-buffer t) @@ -9385,7 +9404,7 @@ With optional ARG, move across that many fields." (defun gnus-summary-button-backward (arg) "Move point to the previous field or button in the article. With optional ARG, move across that many fields." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (let ((win (or (gnus-get-buffer-window gnus-article-buffer t) @@ -9442,7 +9461,7 @@ If only one link is found, browse that directly, otherwise use completion to select a link. The first link marked in the article text with `gnus-collect-urls-primary-text' is the default." - (interactive "P") + (interactive "P" gnus-summary-mode) (let (urls target) (gnus-summary-select-article) (gnus-with-article-buffer @@ -9467,7 +9486,7 @@ default." (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9477,14 +9496,14 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch." (defun gnus-summary-repeat-search-article-forward () "Repeat the previous search forwards." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-last-search-regexp (error "No previous search")) (gnus-summary-search-article-forward gnus-last-search-regexp)) (defun gnus-summary-repeat-search-article-backward () "Repeat the previous search backwards." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-last-search-regexp (error "No previous search")) (gnus-summary-search-article-forward gnus-last-search-regexp t)) @@ -9493,13 +9512,15 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch." "Search for an article containing REGEXP forward. If BACKWARD, search backward instead." (interactive - (list (read-string - (format "Search article %s (regexp%s): " - (if current-prefix-arg "backward" "forward") - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))) - current-prefix-arg)) + (list + (read-string + (format "Search article %s (regexp%s): " + (if current-prefix-arg "backward" "forward") + (if gnus-last-search-regexp + (concat ", default " gnus-last-search-regexp) + ""))) + current-prefix-arg) + gnus-summary-mode) (if (string-equal regexp "") (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp) @@ -9514,11 +9535,13 @@ If BACKWARD, search backward instead." (defun gnus-summary-search-article-backward (regexp) "Search for an article containing REGEXP backward." (interactive - (list (read-string - (format "Search article backward (regexp%s): " - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))))) + (list + (read-string + (format "Search article backward (regexp%s): " + (if gnus-last-search-regexp + (concat ", default " gnus-last-search-regexp) + "")))) + gnus-summary-mode) (gnus-summary-search-article-forward regexp 'backward)) (defun gnus-summary-search-article (regexp &optional backward) @@ -9653,18 +9676,20 @@ that not match REGEXP on HEADER." If HEADER is an empty string (or nil), the match is done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive - (list (let ((completion-ignore-case t)) - (gnus-completing-read - "Header name" - (mapcar #'symbol-name - (append - '(Number Subject From Lines Date - Message-ID Xref References Body) - gnus-extra-headers)) - 'require-match)) - (read-string "Regexp: ") - (read-key-sequence "Command: ") - current-prefix-arg)) + (list + (let ((completion-ignore-case t)) + (gnus-completing-read + "Header name" + (mapcar #'symbol-name + (append + '(Number Subject From Lines Date Message-ID + Xref References Body) + gnus-extra-headers)) + 'require-match)) + (read-string "Regexp: ") + (read-key-sequence "Command: ") + current-prefix-arg) + gnus-summary-mode) (when (equal header "Body") (setq header "")) ;; Hidden thread subtrees must be searched as well. @@ -9688,7 +9713,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (defun gnus-summary-beginning-of-article () "Scroll the article back to the beginning." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9699,7 +9724,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (defun gnus-summary-end-of-article () "Scroll to the end of the article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9732,7 +9757,9 @@ If the optional first argument FILENAME is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." - (interactive (list (ps-print-preprint current-prefix-arg))) + (interactive + (list (ps-print-preprint current-prefix-arg)) + gnus-summary-mode) (dolist (article (gnus-summary-work-articles n)) (gnus-summary-select-article nil nil 'pseudo article) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9772,7 +9799,7 @@ to save in." "Show a complete version of the current article. This is only useful if you're looking at a partial version of the article currently." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-keep-backlog nil) (gnus-use-cache nil) (gnus-agent nil) @@ -9799,7 +9826,7 @@ If ARG (the prefix) is non-nil and not a number, show the article, but without running any of the article treatment functions article. Normally, the keystroke is `C-u g'. When using `C-u C-u g', show the raw article." - (interactive "P") + (interactive "P" gnus-summary-mode) (cond ((numberp arg) (gnus-summary-show-article t) @@ -9875,14 +9902,14 @@ C-u g', show the raw article." (defun gnus-summary-show-raw-article () "Show the raw article without any article massaging functions being run." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-show-article t)) (defun gnus-summary-verbose-headers (&optional arg) "Toggle permanent full header display. If ARG is a positive number, turn header display on. If ARG is a negative number, turn header display off." - (interactive "P") + (interactive "P" gnus-summary-mode) (setq gnus-show-all-headers (cond ((or (not (numberp arg)) (zerop arg)) @@ -9901,7 +9928,7 @@ If ARG is a negative number, turn header display off." "Show the headers if they are hidden, or hide them if they are shown. If ARG is a positive number, show the entire header. If ARG is a negative number, hide the unwanted header lines." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((window (and (gnus-buffer-live-p gnus-article-buffer) (get-buffer-window gnus-article-buffer t)))) (with-current-buffer gnus-article-buffer @@ -9947,14 +9974,14 @@ If ARG is a negative number, hide the unwanted header lines." (defun gnus-summary-show-all-headers () "Make all header lines visible." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-toggle-header 1)) (defun gnus-summary-caesar-message (&optional arg) "Caesar rotate the current article by 13. With a non-numerical prefix, also rotate headers. A numerical prefix specifies how many places to rotate each letter forward." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9977,7 +10004,7 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/') installed for this command to work." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9991,7 +10018,7 @@ installed for this command to work." (defun gnus-summary-morse-message (&optional _arg) "Morse decode the current article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -10012,7 +10039,7 @@ installed for this command to work." (defun gnus-summary-stop-page-breaking () "Stop page breaking in the current article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (widen) @@ -10042,7 +10069,7 @@ newsgroup that you want to move to have to support the `request-move' and `request-accept' functions. ACTION can be either `move' (the default), `crosspost' or `copy'." - (interactive "P") + (interactive "P" gnus-summary-mode) (unless action (setq action 'move)) ;; Check whether the source group supports the required functions. @@ -10348,13 +10375,13 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Copy the current article to some other group. Arguments have the same meanings as in `gnus-summary-move-article'." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-move-article n to-newsgroup select-method 'copy)) (defun gnus-summary-crosspost-article (&optional n) "Crosspost the current article to some other group. Arguments have the same meanings as in `gnus-summary-move-article'." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-move-article n nil nil 'crosspost)) (defcustom gnus-summary-respool-default-method nil @@ -10398,7 +10425,8 @@ latter case, they will be copied into the relevant groups." (t (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms))) (cdr (assoc (gnus-completing-read "Server name" ms-alist t) - ms-alist)))))))) + ms-alist))))))) + gnus-summary-mode) (unless method (error "No method given for respooling")) (if (assoc (symbol-name @@ -10409,7 +10437,7 @@ latter case, they will be copied into the relevant groups." (defun gnus-summary-import-article (file &optional edit) "Import an arbitrary file into a mail newsgroup." - (interactive "fImport file: \nP") + (interactive "fImport file: \nP" gnus-summary-mode) (let ((group gnus-newsgroup-name) atts lines group-art) (unless (gnus-check-backend-function 'request-accept-article group) @@ -10453,7 +10481,7 @@ latter case, they will be copied into the relevant groups." (defun gnus-summary-create-article () "Create an article in a mail newsgroup." - (interactive) + (interactive nil gnus-summary-mode) (let ((group gnus-newsgroup-name) (now (current-time)) group-art) @@ -10477,7 +10505,7 @@ latter case, they will be copied into the relevant groups." (defun gnus-summary-article-posted-p () "Say whether the current (mail) article is available from news as well. This will be the case if the article has both been mailed and posted." - (interactive) + (interactive nil gnus-summary-mode) (let ((id (mail-header-references (gnus-summary-article-header))) (gnus-override-method (car (gnus-refer-article-methods)))) (if (gnus-request-head id "") @@ -10489,7 +10517,7 @@ This will be the case if the article has both been mailed and posted." (defun gnus-summary-expire-articles (&optional now) "Expire all articles that are marked as expirable in the current group." - (interactive) + (interactive nil gnus-summary-mode) (when (and (not gnus-group-is-exiting-without-update-p) (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)) @@ -10558,7 +10586,7 @@ This will be the case if the article has both been mailed and posted." "Expunge all expirable articles in the current group. This means that *all* articles that are marked as expirable will be deleted forever, right now." - (interactive) + (interactive nil gnus-summary-mode) (or gnus-expert-user (gnus-yes-or-no-p "Are you really, really sure you want to delete all expirable messages? ") @@ -10578,7 +10606,7 @@ delete these instead. If `gnus-novice-user' is non-nil you will be asked for confirmation before the articles are deleted." - (interactive "P") + (interactive "P" gnus-summary-mode) (unless (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion")) @@ -10628,7 +10656,7 @@ If ARG is 2, edit the raw articles even in read-only groups. If ARG is 3, edit the articles with the current handles. Otherwise, allow editing of articles even in read-only groups." - (interactive "P") + (interactive "P" gnus-summary-mode) (let (force raw current-handles) (cond ((null arg)) @@ -10708,7 +10736,7 @@ groups." (defun gnus-summary-edit-article-done (&optional references read-only buffer no-highlight) "Make edits to the current article permanent." - (interactive) + (interactive nil gnus-summary-mode) (save-excursion ;; The buffer restriction contains the entire article if it exists. (when (article-goto-body) @@ -10796,7 +10824,8 @@ groups." (list (progn (message "%s" (concat (this-command-keys) "- ")) - (read-char)))) + (read-char))) + gnus-summary-mode) (message "") (gnus-summary-edit-article) (execute-kbd-macro (concat (this-command-keys) key)) @@ -10809,7 +10838,7 @@ groups." (defun gnus-summary-respool-query (&optional silent trace) "Query where the respool algorithm would put this article." - (interactive) + (interactive nil gnus-summary-mode) (let (gnus-mark-article-hook) (gnus-summary-select-article) (with-current-buffer gnus-original-article-buffer @@ -10839,7 +10868,7 @@ groups." (defun gnus-summary-respool-trace () "Trace where the respool algorithm would put this article. Display a buffer showing all fancy splitting patterns which matched." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-respool-query nil t)) ;; Summary marking commands. @@ -10848,7 +10877,7 @@ Display a buffer showing all fancy splitting patterns which matched." "Mark articles which has the same subject as read, and then select the next. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (when unmark (setq unmark (prefix-numeric-value unmark))) (let ((count @@ -10866,7 +10895,7 @@ If UNMARK is negative, tick articles." "Mark articles which has the same subject as read. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (when unmark (setq unmark (prefix-numeric-value unmark))) (let ((count @@ -10916,7 +10945,7 @@ If optional argument UNMARK is negative, mark articles as unread instead." If N is negative, mark backward instead. If UNMARK is non-nil, remove the process mark instead. The difference between N and the actual number of articles marked is returned." - (interactive "P") + (interactive "P" gnus-summary-mode) (if (and (null n) (and transient-mark-mode mark-active)) (gnus-uu-mark-region (region-beginning) (region-end) unmark) (setq n (prefix-numeric-value n)) @@ -10940,12 +10969,12 @@ number of articles marked is returned." "Remove the process mark from the next N articles. If N is negative, unmark backward instead. The difference between N and the actual number of articles unmarked is returned." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mark-as-processable n t)) (defun gnus-summary-unmark-all-processable () "Remove the process mark from all articles." - (interactive) + (interactive nil gnus-summary-mode) (save-excursion (while gnus-newsgroup-processable (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) @@ -10969,20 +10998,21 @@ the actual number of articles unmarked is returned." "Mark N articles forward as expirable. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-expirable-mark)) (defun gnus-summary-mark-as-spam (n) "Mark N articles forward as spam. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-spam-mark)) (defun gnus-summary-mark-article-as-replied (article) "Mark ARTICLE as replied to and update the summary line. ARTICLE can also be a list of articles." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) + gnus-summary-mode) (let ((articles (if (listp article) article (list article)))) (dolist (article articles) (unless (numberp article) @@ -11004,7 +11034,8 @@ ARTICLE can also be a list of articles." (defun gnus-summary-set-bookmark (article) "Set a bookmark in current article." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) + gnus-summary-mode) (when (or (not (get-buffer gnus-article-buffer)) (not gnus-current-article) (not gnus-article-current) @@ -11028,7 +11059,8 @@ ARTICLE can also be a list of articles." (defun gnus-summary-remove-bookmark (article) "Remove the bookmark from the current article." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) + gnus-summary-mode) ;; Remove old bookmark, if one exists. (if (not (assq article gnus-newsgroup-bookmarks)) (gnus-message 6 "No bookmark in current article.") @@ -11040,7 +11072,7 @@ ARTICLE can also be a list of articles." "Mark N articles forward as dormant. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-dormant-mark)) (defun gnus-summary-set-process-mark (article) @@ -11075,7 +11107,7 @@ If N is negative, mark backwards instead. Mark with MARK, ?r by default. The difference between N and the actual number of articles marked is returned. If NO-EXPIRE, auto-expiry will be inhibited." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-show-thread) (let ((backward (< n 0)) (gnus-summary-goto-unread @@ -11339,20 +11371,20 @@ If NO-EXPIRE, auto-expiry will be inhibited." "Tick N articles forwards. If N is negative, tick backwards instead. The difference between N and the number of articles ticked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-ticked-mark)) (defun gnus-summary-tick-article-backward (n) "Tick N articles backwards. The difference between N and the number of articles ticked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward (- n) gnus-ticked-mark)) (defun gnus-summary-tick-article (&optional article clear-mark) "Mark current article as unread. Optional 1st argument ARTICLE specifies article number to be marked as unread. Optional 2nd argument CLEAR-MARK remove any kinds of mark." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-mark-article article (if clear-mark gnus-unread-mark gnus-ticked-mark))) @@ -11361,14 +11393,14 @@ Optional 2nd argument CLEAR-MARK remove any kinds of mark." If N is negative, mark backwards instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire)) (defun gnus-summary-mark-as-read-backward (n) "Mark the N articles as read backwards. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward (- n) gnus-del-mark gnus-inhibit-user-auto-expire)) @@ -11382,13 +11414,13 @@ MARK specifies a string to be inserted at the beginning of the line." "Clear marks from N articles forward. If N is negative, clear backward instead. The difference between N and the number of marks cleared is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-unread-mark)) (defun gnus-summary-clear-mark-backward (n) "Clear marks from N articles backward. The difference between N and the number of marks cleared is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward (- n) gnus-unread-mark)) (defun gnus-summary-mark-unread-as-read () @@ -11421,7 +11453,7 @@ The difference between N and the number of marks cleared is returned." "Mark all unread articles between point and mark as read. If given a prefix, mark all articles between point and mark as read, even ticked and dormant ones." - (interactive "r\nP") + (interactive "r\nP" gnus-summary-mode) (save-excursion (let (article) (goto-char point) @@ -11438,7 +11470,7 @@ even ticked and dormant ones." (defun gnus-summary-mark-below (score mark) "Mark articles with score less than SCORE with MARK." - (interactive "P\ncMark: ") + (interactive "P\ncMark: " gnus-summary-mode) (setq score (if score (prefix-numeric-value score) (or gnus-summary-default-score 0))) @@ -11452,22 +11484,22 @@ even ticked and dormant ones." (defun gnus-summary-kill-below (&optional score) "Mark articles with score below SCORE as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mark-below score gnus-killed-mark)) (defun gnus-summary-clear-above (&optional score) "Clear all marks from articles with score above SCORE." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mark-above score gnus-unread-mark)) (defun gnus-summary-tick-above (&optional score) "Tick all articles with score above SCORE." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mark-above score gnus-ticked-mark)) (defun gnus-summary-mark-above (score mark) "Mark articles with score over SCORE with MARK." - (interactive "P\ncMark: ") + (interactive "P\ncMark: " gnus-summary-mode) (setq score (if score (prefix-numeric-value score) (or gnus-summary-default-score 0))) @@ -11483,7 +11515,7 @@ even ticked and dormant ones." (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) (defun gnus-summary-limit-include-expunged (&optional no-error) "Display all the hidden articles that were expunged for low scores." - (interactive) + (interactive nil gnus-summary-mode) (let ((inhibit-read-only t)) (let ((scored gnus-newsgroup-scored) headers h) @@ -11520,7 +11552,7 @@ Note that this function will only catch up the unread article in the current summary buffer limitation. The number of articles marked as read is returned." - (interactive "P") + (interactive "P" gnus-summary-mode) (prog1 (save-excursion (when (or quietly @@ -11569,7 +11601,7 @@ The number of articles marked as read is returned." (defun gnus-summary-catchup-to-here (&optional all) "Mark all unticked articles before the current one as read. If ALL is non-nil, also mark ticked and dormant articles as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (gnus-save-hidden-threads (let ((beg (point))) @@ -11581,7 +11613,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read." (defun gnus-summary-catchup-from-here (&optional all) "Mark all unticked articles after (and including) the current one as read. If ALL is non-nil, also mark ticked and dormant articles as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (gnus-save-hidden-threads (let ((beg (point))) @@ -11594,14 +11626,14 @@ If ALL is non-nil, also mark ticked and dormant articles as read." "Mark all articles in this newsgroup as read. This command is dangerous. Normally, you want \\[gnus-summary-catchup] instead, which marks only unread articles as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-catchup t quietly)) (defun gnus-summary-catchup-and-exit (&optional all quietly) "Mark all unread articles in this group as read, then exit. If prefix argument ALL is non-nil, all articles are marked as read. If QUIETLY is non-nil, no questions will be asked." - (interactive "P") + (interactive "P" gnus-summary-mode) (when (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. (if (and (not (gnus-group-quit-config gnus-newsgroup-name)) @@ -11613,14 +11645,14 @@ If QUIETLY is non-nil, no questions will be asked." "Mark all articles in this newsgroup as read, and then exit. This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit] instead, which marks only unread articles as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-catchup-and-exit t quietly)) (defun gnus-summary-catchup-and-goto-next-group (&optional all) "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (gnus-summary-catchup all)) (gnus-summary-next-group)) @@ -11629,7 +11661,7 @@ read." "Mark all articles in this group as read and select the previous group. If given a prefix, mark all articles, unread as well as ticked, as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (gnus-summary-catchup all)) (gnus-summary-next-group nil nil t)) @@ -11705,7 +11737,7 @@ with that article." (defun gnus-summary-rethread-current () "Rethread the thread the current article is part of." - (interactive) + (interactive nil gnus-summary-mode) (let* ((gnus-show-threads t) (article (gnus-summary-article-number)) (id (mail-header-id (gnus-summary-article-header))) @@ -11720,7 +11752,7 @@ with that article." Note that the re-threading will only work if `gnus-thread-ignore-subject' is non-nil or the Subject: of both articles are the same." - (interactive) + (interactive nil gnus-summary-mode) (unless (not (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing")) (unless (<= (length gnus-newsgroup-processable) 1) @@ -11739,9 +11771,10 @@ is non-nil or the Subject: of both articles are the same." "Make PARENT the parent of CHILDREN. When called interactively, PARENT is the current article and CHILDREN are the process-marked articles." - (interactive - (list (gnus-summary-article-number) - (gnus-summary-work-articles nil))) + (interactive (list + (gnus-summary-article-number) + (gnus-summary-work-articles nil)) + gnus-summary-mode) (dolist (child children) (save-window-excursion (let ((gnus-article-buffer " *reparent*")) @@ -11774,7 +11807,7 @@ are the process-marked articles." (defun gnus-summary-toggle-threads (&optional arg) "Toggle showing conversation threads. If ARG is positive number, turn showing conversation threads on." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) (setq gnus-show-threads (if (null arg) (not gnus-show-threads) @@ -11786,7 +11819,7 @@ If ARG is positive number, turn showing conversation threads on." (defun gnus-summary-show-all-threads () "Show all threads." - (interactive) + (interactive nil gnus-summary-mode) (remove-overlays (point-min) (point-max) 'invisible 'gnus-sum) (gnus-summary-position-point)) @@ -11796,7 +11829,7 @@ If ARG is positive number, turn showing conversation threads on." (defun gnus-summary-show-thread () "Show thread subtrees. Returns nil if no thread was there to be shown." - (interactive) + (interactive nil gnus-summary-mode) (let* ((orig (point)) (end (point-at-eol)) (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end)))) @@ -11837,7 +11870,7 @@ Returns nil if no thread was there to be shown." "Hide all thread subtrees. If PREDICATE is supplied, threads that satisfy this predicate will not be hidden." - (interactive) + (interactive nil gnus-summary-mode) (save-excursion (goto-char (point-min)) (let ((end nil) @@ -11856,7 +11889,7 @@ will not be hidden." (defun gnus-summary-hide-thread () "Hide thread subtrees. Returns nil if no threads were there to be hidden." - (interactive) + (interactive nil gnus-summary-mode) (beginning-of-line) (let ((start (point)) (starteol (line-end-position)) @@ -11908,7 +11941,7 @@ Returns the difference between N and the number of skips actually done. If SILENT, don't output messages." - (interactive "p") + (interactive "p" gnus-summary-mode) (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) @@ -11924,7 +11957,7 @@ If SILENT, don't output messages." "Go to the same level previous N'th thread. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-next-thread (- n))) (defun gnus-summary-go-down-thread () @@ -11944,7 +11977,7 @@ done." If N is negative, go up instead. Returns the difference between N and how many steps down that were taken." - (interactive "p") + (interactive "p" gnus-summary-mode) (let ((up (< n 0)) (n (abs n))) (while (and (> n 0) @@ -11961,18 +11994,18 @@ taken." If N is negative, go down instead. Returns the difference between N and how many steps down that were taken." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-down-thread (- n))) (defun gnus-summary-top-thread () "Go to the top of the thread." - (interactive) + (interactive nil gnus-summary-mode) (while (gnus-summary-go-up-thread)) (gnus-summary-article-number)) (defun gnus-summary-expire-thread () "Mark articles under current thread as expired." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-kill-thread 0)) (defun gnus-summary-kill-thread (&optional unmark) @@ -11980,7 +12013,7 @@ taken." If the prefix argument is positive, remove any kinds of marks. If the prefix argument is zero, mark thread as expired. If the prefix argument is negative, tick articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (when unmark (setq unmark (prefix-numeric-value unmark))) (let ((articles (gnus-summary-articles-in-thread)) @@ -12015,82 +12048,82 @@ If the prefix argument is negative, tick articles instead." (defun gnus-summary-sort-by-number (&optional reverse) "Sort the summary buffer by article number. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'number reverse)) (defun gnus-summary-sort-by-most-recent-number (&optional reverse) "Sort the summary buffer by most recent article number. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'most-recent-number reverse)) (defun gnus-summary-sort-by-random (&optional reverse) "Randomize the order in the summary buffer. Argument REVERSE means to randomize in reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'random reverse)) (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'author reverse)) (defun gnus-summary-sort-by-recipient (&optional reverse) "Sort the summary buffer by recipient name alphabetically. If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'recipient reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'subject reverse)) (defun gnus-summary-sort-by-date (&optional reverse) "Sort the summary buffer by date. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'date reverse)) (defun gnus-summary-sort-by-most-recent-date (&optional reverse) "Sort the summary buffer by most recent date. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'most-recent-date reverse)) (defun gnus-summary-sort-by-score (&optional reverse) "Sort the summary buffer by score. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'score reverse)) (defun gnus-summary-sort-by-lines (&optional reverse) "Sort the summary buffer by the number of lines. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'lines reverse)) (defun gnus-summary-sort-by-chars (&optional reverse) "Sort the summary buffer by article length. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'chars reverse)) (defun gnus-summary-sort-by-marks (&optional reverse) "Sort the summary buffer by article marks. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'marks reverse)) (defun gnus-summary-sort-by-original (&optional _reverse) "Sort the summary buffer using the default sorting method. Argument REVERSE means reverse order." - (interactive) + (interactive nil gnus-summary-mode) (let* ((inhibit-read-only t) (gnus-summary-prepare-hook nil)) ;; We do the sorting by regenerating the threads. @@ -12139,7 +12172,7 @@ will not be marked as saved. The `gnus-prompt-before-saving' variable says how prompting is performed." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) (save-buffer (save-excursion @@ -12208,7 +12241,7 @@ is neither omitted nor the symbol `r', force including all headers regardless of the `:headers' property. If it is the symbol `r', articles that are not decoded and include all headers will be piped no matter what the properties `:decode' and `:headers' are." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-summary-mode) (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) (result-buffer shell-command-buffer-name) @@ -12260,7 +12293,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) (gnus-summary-save-article arg))) @@ -12271,7 +12304,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) (gnus-summary-save-article arg))) @@ -12282,7 +12315,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) (gnus-summary-save-article arg))) @@ -12293,7 +12326,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-write-to-file)) (gnus-summary-save-article arg))) @@ -12304,7 +12337,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) (gnus-summary-save-article arg))) @@ -12315,7 +12348,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file)) (gnus-summary-save-article arg))) @@ -12326,14 +12359,14 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint)) (gnus-summary-save-article arg t))) (defun gnus-summary-pipe-message (program) "Pipe the current article through PROGRAM." - (interactive "sProgram: ") + (interactive "sProgram: " gnus-summary-mode) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -12451,7 +12484,8 @@ If REVERSE, save parts that do not match TYPE." (read-directory-name "Save to directory: " gnus-summary-save-parts-last-directory nil t)) - current-prefix-arg)) + current-prefix-arg) + gnus-summary-mode) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) gnus-article-prepare-hook @@ -12590,12 +12624,12 @@ If REVERSE, save parts that do not match TYPE." (defun gnus-summary-edit-global-kill (article) "Edit the \"global\" kill file." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) gnus-summary-mode) (gnus-group-edit-global-kill article)) (defun gnus-summary-edit-local-kill () "Edit a local kill file applied to the current newsgroup." - (interactive) + (interactive nil gnus-summary-mode) (setq gnus-current-headers (gnus-summary-article-header)) (gnus-group-edit-local-kill (gnus-summary-article-number) gnus-newsgroup-name)) @@ -12893,7 +12927,7 @@ UNREAD is a sorted list." "Display the current article buffer fully MIME-buttonized. If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are treated as multipart/mixed." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-unbuttonized-mime-types nil) (gnus-mime-display-multipart-as-mixed show-all-parts)) @@ -12901,7 +12935,7 @@ treated as multipart/mixed." (defun gnus-summary-repair-multipart (article) "Add a Content-Type header to a multipart article without one." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) gnus-summary-mode) (gnus-with-article article (message-narrow-to-head) (message-remove-header "Mime-Version") @@ -12921,7 +12955,7 @@ treated as multipart/mixed." (defun gnus-summary-toggle-display-buttonized () "Toggle the buttonizing of the article buffer." - (interactive) + (interactive nil gnus-summary-mode) (require 'gnus-art) (if (setq gnus-inhibit-mime-unbuttonizing (not gnus-inhibit-mime-unbuttonizing)) @@ -12976,7 +13010,7 @@ If N is negative, move in reverse order. The difference between N and the actual number of articles marked is returned." name (cadr lway)) - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway)))) (defun gnus-summary-generic-mark (n mark move unread) @@ -13059,7 +13093,7 @@ returned." "Insert all old articles in this group. If ALL is non-nil, already read articles become readable. If ALL is a number, fetch this number of articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (prog1 (let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<)) older len) @@ -13133,7 +13167,7 @@ If ALL is a number, fetch this number of articles." (defun gnus-summary-insert-new-articles () "Insert all new articles in this group." - (interactive) + (interactive nil gnus-summary-mode) (let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<)) (old-high gnus-newsgroup-highest) (nnmail-fetched-sources (list t)) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 3253b7853dc..b3d17bc03fb 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -146,7 +146,8 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-topic-jump-to-topic (topic) "Go to TOPIC." (interactive - (list (gnus-completing-read "Go to topic" (gnus-topic-list) t))) + (list (gnus-completing-read "Go to topic" (gnus-topic-list) t)) + gnus-topic-mode) (let ((inhibit-read-only t)) (dolist (topic (gnus-current-topics topic)) (unless (gnus-topic-goto-topic topic) @@ -235,12 +236,12 @@ If RECURSIVE is t, return groups in its subtopics too." (defun gnus-topic-goto-previous-topic (n) "Go to the N'th previous topic." - (interactive "p") + (interactive "p" gnus-topic-mode) (gnus-topic-goto-next-topic (- n))) (defun gnus-topic-goto-next-topic (n) "Go to the N'th next topic." - (interactive "p") + (interactive "p" gnus-topic-mode) (let ((backward (< n 0)) (n (abs n)) (topic (gnus-current-topic))) @@ -661,7 +662,7 @@ articles in the topic and its subtopics." (defun gnus-topic-update-topics-containing-group (group) "Update all topics that have GROUP as a member." - (when (and (eq major-mode 'gnus-group-mode) + (when (and (eq major-mode 'gnus-topic-mode) gnus-topic-mode) (save-excursion (let ((alist gnus-topic-alist)) @@ -677,7 +678,7 @@ articles in the topic and its subtopics." (defun gnus-topic-update-topic () "Update all parent topics to the current group." - (when (and (eq major-mode 'gnus-group-mode) + (when (and (eq major-mode 'gnus-topic-mode) gnus-topic-mode) (let ((group (gnus-group-group-name)) (m (point-marker)) @@ -1122,7 +1123,9 @@ articles in the topic and its subtopics." (define-minor-mode gnus-topic-mode "Minor mode for topicsifying Gnus group buffers." - :lighter " Topic" :keymap gnus-topic-mode-map + :lighter " Topic" + :keymap gnus-topic-mode-map + :interactive (gnus-group-mode) (if (not (derived-mode-p 'gnus-group-mode)) (setq gnus-topic-mode nil) ;; Infest Gnus with topics. @@ -1172,7 +1175,7 @@ articles in the group. If ALL is a negative number, fetch this number of the earliest articles in the group. If performed over a topic line, toggle folding the topic." - (interactive "P") + (interactive "P" gnus-topic-mode) (when (and (eobp) (not (gnus-group-group-name))) (forward-line -1)) (if (gnus-group-topic-p) @@ -1184,13 +1187,13 @@ If performed over a topic line, toggle folding the topic." (defun gnus-mouse-pick-topic (e) "Select the group or topic under the mouse pointer." - (interactive "e") + (interactive "e" gnus-topic-mode) (mouse-set-point e) (gnus-topic-read-group nil)) (defun gnus-topic-expire-articles (topic) "Expire articles in this topic or group." - (interactive (list (gnus-group-topic-name))) + (interactive (list (gnus-group-topic-name)) gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-expire-articles) (save-excursion @@ -1205,7 +1208,7 @@ If performed over a topic line, toggle folding the topic." (defun gnus-topic-catchup-articles (topic) "Catchup this topic or group. Also see `gnus-group-catchup'." - (interactive (list (gnus-group-topic-name))) + (interactive (list (gnus-group-topic-name)) gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-catchup-current) (save-excursion @@ -1232,7 +1235,7 @@ be auto-selected upon group entry. If GROUP is non-nil, fetch that group. If performed over a topic line, toggle folding the topic." - (interactive "P") + (interactive "P" gnus-topic-mode) (when (and (eobp) (not (gnus-group-group-name))) (forward-line -1)) (if (gnus-group-topic-p) @@ -1247,7 +1250,8 @@ When used interactively, PARENT will be the topic under point." (interactive (list (read-string "New topic: ") - (gnus-current-topic))) + (gnus-current-topic)) + gnus-topic-mode) ;; Check whether this topic already exists. (when (gnus-topic-find-topology topic) (error "Topic already exists")) @@ -1284,7 +1288,8 @@ If COPYP, copy the groups instead." (interactive (list current-prefix-arg (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t - nil 'gnus-topic-history))) + nil 'gnus-topic-history)) + gnus-topic-mode) (let ((use-marked (and (not n) (not (and transient-mark-mode mark-active)) gnus-group-marked t)) (groups (gnus-group-process-prefix n)) @@ -1309,7 +1314,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-remove-group (&optional n) "Remove the current group from the topic." - (interactive "P") + (interactive "P" gnus-topic-mode) (let ((use-marked (and (not n) (not (and transient-mark-mode mark-active)) gnus-group-marked t)) (groups (gnus-group-process-prefix n))) @@ -1331,12 +1336,13 @@ If COPYP, copy the groups instead." (interactive (list current-prefix-arg (gnus-completing-read - "Copy to topic" (mapcar #'car gnus-topic-alist) t))) + "Copy to topic" (mapcar #'car gnus-topic-alist) t)) + gnus-topic-mode) (gnus-topic-move-group n topic t)) (defun gnus-topic-kill-group (&optional n discard) "Kill the next N groups." - (interactive "P") + (interactive "P" gnus-topic-mode) (if (gnus-group-topic-p) (let ((topic (gnus-group-topic-name))) (push (cons @@ -1356,7 +1362,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-yank-group (&optional arg) "Yank the last topic." - (interactive "p") + (interactive "p" gnus-topic-mode) (if gnus-topic-killed-topics (let* ((previous (or (gnus-group-topic-name) @@ -1405,7 +1411,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-hide-topic (&optional permanent) "Hide the current topic. If PERMANENT, make it stay hidden in subsequent sessions as well." - (interactive "P") + (interactive "P" gnus-topic-mode) (when (gnus-current-topic) (gnus-topic-goto-topic (gnus-current-topic)) (if permanent @@ -1418,7 +1424,7 @@ If PERMANENT, make it stay hidden in subsequent sessions as well." (defun gnus-topic-show-topic (&optional permanent) "Show the hidden topic. If PERMANENT, make it stay shown in subsequent sessions as well." - (interactive "P") + (interactive "P" gnus-topic-mode) (when (gnus-group-topic-p) (if (not permanent) (gnus-topic-remove-topic t nil) @@ -1433,9 +1439,11 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (defun gnus-topic-mark-topic (topic &optional unmark non-recursive) "Mark all groups in the TOPIC with the process mark. If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." - (interactive (list (gnus-group-topic-name) - nil - (and current-prefix-arg t))) + (interactive + (list (gnus-group-topic-name) + nil + (and current-prefix-arg t)) + gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-mark-group) (save-excursion @@ -1450,14 +1458,15 @@ If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (interactive (list (gnus-group-topic-name) nil - (and current-prefix-arg t))) + (and current-prefix-arg t)) + gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-unmark-group) (gnus-topic-mark-topic topic t non-recursive))) (defun gnus-topic-get-new-news-this-topic (&optional n) "Check for new news in the current topic." - (interactive "P") + (interactive "P" gnus-topic-mode) (if (not (gnus-group-topic-p)) (gnus-group-get-new-news-this-group n) (let* ((topic (gnus-group-topic-name)) @@ -1475,7 +1484,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (list (setq topic (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t)) - (read-string (format "Move to %s (regexp): " topic)))))) + (read-string (format "Move to %s (regexp): " topic))))) + gnus-topic-mode) (gnus-group-mark-regexp regexp) (gnus-topic-move-group nil topic copyp)) @@ -1486,12 +1496,13 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (mapcar #'car gnus-topic-alist) t))) (nreverse (list topic - (read-string (format "Copy to %s (regexp): " topic)))))) + (read-string (format "Copy to %s (regexp): " topic))))) + gnus-topic-mode) (gnus-topic-move-matching regexp topic t)) (defun gnus-topic-delete (topic) "Delete a topic." - (interactive (list (gnus-group-topic-name))) + (interactive (list (gnus-group-topic-name)) gnus-topic-mode) (unless topic (error "No topic to be deleted")) (let ((entry (assoc topic gnus-topic-alist)) @@ -1512,7 +1523,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (interactive (let ((topic (gnus-current-topic))) (list topic - (read-string (format "Rename %s to: " topic) topic)))) + (read-string (format "Rename %s to: " topic) topic))) + gnus-topic-mode) ;; Check whether the new name exists. (when (gnus-topic-find-topology new-name) (error "Topic `%s' already exists" new-name)) @@ -1535,7 +1547,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (defun gnus-topic-indent (&optional unindent) "Indent a topic -- make it a sub-topic of the previous topic. If UNINDENT, remove an indentation." - (interactive "P") + (interactive "P" gnus-topic-mode) (if unindent (gnus-topic-unindent) (let* ((topic (gnus-current-topic)) @@ -1555,7 +1567,7 @@ If UNINDENT, remove an indentation." (defun gnus-topic-unindent () "Unindent a topic." - (interactive) + (interactive nil gnus-topic-mode) (let* ((topic (gnus-current-topic)) (parent (gnus-topic-parent-topic topic)) (grandparent (gnus-topic-parent-topic parent))) @@ -1574,7 +1586,7 @@ If UNINDENT, remove an indentation." (defun gnus-topic-list-active (&optional force) "List all groups that Gnus knows about in a topicsified fashion. If FORCE, always re-read the active file." - (interactive "P") + (interactive "P" gnus-topic-mode) (when force (gnus-get-killed-groups)) (gnus-topic-grok-active force) @@ -1585,7 +1597,7 @@ If FORCE, always re-read the active file." (defun gnus-topic-toggle-display-empty-topics () "Show/hide topics that have no unread articles." - (interactive) + (interactive nil gnus-topic-mode) (setq gnus-topic-display-empty-topics (not gnus-topic-display-empty-topics)) (gnus-group-list-groups) @@ -1598,7 +1610,7 @@ If FORCE, always re-read the active file." (defun gnus-topic-edit-parameters (group) "Edit the group parameters of GROUP. If performed on a topic, edit the topic parameters instead." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-topic-mode) (if group (gnus-group-edit-group-parameters group) (if (not (gnus-group-topic-p)) @@ -1642,7 +1654,8 @@ If performed on a topic, edit the topic parameters instead." (defun gnus-topic-sort-groups (func &optional reverse) "Sort the current topic according to FUNC. If REVERSE, reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) + (interactive (list gnus-group-sort-function current-prefix-arg) + gnus-topic-mode) (let ((topic (assoc (gnus-current-topic) gnus-topic-alist))) (gnus-topic-sort-topic topic (gnus-make-sort-function func) reverse) @@ -1651,43 +1664,43 @@ If REVERSE, reverse the sorting order." (defun gnus-topic-sort-groups-by-alphabet (&optional reverse) "Sort the current topic alphabetically by group name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse)) (defun gnus-topic-sort-groups-by-unread (&optional reverse) "Sort the current topic by number of unread articles. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse)) (defun gnus-topic-sort-groups-by-level (&optional reverse) "Sort the current topic by group level. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse)) (defun gnus-topic-sort-groups-by-score (&optional reverse) "Sort the current topic by group score. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse)) (defun gnus-topic-sort-groups-by-rank (&optional reverse) "Sort the current topic by group rank. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse)) (defun gnus-topic-sort-groups-by-method (&optional reverse) "Sort the current topic alphabetically by backend name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) (defun gnus-topic-sort-groups-by-server (&optional reverse) "Sort the current topic alphabetically by server name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-server reverse)) (defun gnus-topic-sort-topics-1 (top reverse) @@ -1708,7 +1721,8 @@ If REVERSE, reverse the sorting order." (list (gnus-completing-read "Sort topics in" (mapcar #'car gnus-topic-alist) t (gnus-current-topic)) - current-prefix-arg)) + current-prefix-arg) + gnus-topic-mode) (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) gnus-topic-topology))) (gnus-topic-sort-topics-1 topic-topology reverse) @@ -1721,7 +1735,8 @@ If REVERSE, reverse the sorting order." (interactive (list (gnus-group-topic-name) - (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t))) + (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t)) + gnus-topic-mode) (unless (and current to) (error "Can't find topic")) (let ((current-top (cdr (gnus-topic-find-topology current))) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 32a87851549..bd9a1a33ec3 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -355,7 +355,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-decode-uu (&optional n) "Uudecodes the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-uustrip-article n)) (defun gnus-uu-decode-uu-and-save (n dir) @@ -364,13 +364,14 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (file-name-as-directory (read-directory-name "Uudecode and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) + gnus-uu-default-dir + gnus-uu-default-dir t))) + gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-uustrip-article n dir nil nil t)) (defun gnus-uu-decode-unshar (&optional n) "Unshars the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-unshar-article n nil nil 'scan t)) (defun gnus-uu-decode-unshar-and-save (n dir) @@ -379,8 +380,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (file-name-as-directory (read-directory-name "Unshar and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) + gnus-uu-default-dir + gnus-uu-default-dir t))) + gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-unshar-article n dir nil 'scan t)) (defun gnus-uu-decode-save (n file) @@ -391,7 +393,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-directory-name "Save articles in dir: " gnus-uu-default-dir gnus-uu-default-dir) (read-file-name - "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir)))) + "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir))) + gnus-article-mode gnus-summary-mode) (setq gnus-uu-saved-article-name file) (gnus-uu-decode-with-method #'gnus-uu-save-article n nil t)) @@ -401,8 +404,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (file-name-as-directory (read-directory-name "Unbinhex and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir)))) + gnus-uu-default-dir + gnus-uu-default-dir))) + gnus-article-mode gnus-summary-mode) (gnus-uu-initialize) (setq gnus-uu-binhex-article-name (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) @@ -414,14 +418,15 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (file-name-as-directory (read-directory-name "yEnc decode and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir)))) + gnus-uu-default-dir + gnus-uu-default-dir))) + gnus-article-mode gnus-summary-mode) (setq gnus-uu-yenc-article-name nil) (gnus-uu-decode-with-method #'gnus-uu-yenc-article n dir nil t)) (defun gnus-uu-decode-uu-view (&optional n) "Uudecodes and views the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu n))) @@ -431,13 +436,14 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (read-file-name "Uudecode, view and save in dir: " gnus-uu-default-dir - gnus-uu-default-dir t))) + gnus-uu-default-dir t)) + gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu-and-save n dir))) (defun gnus-uu-decode-unshar-view (&optional n) "Unshars and views the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-unshar n))) @@ -447,7 +453,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (read-file-name "Unshar, view and save in dir: " gnus-uu-default-dir - gnus-uu-default-dir t))) + gnus-uu-default-dir t)) + gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-unshar-and-save n dir))) @@ -459,7 +466,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-directory-name "Save articles in dir: " gnus-uu-default-dir gnus-uu-default-dir) (read-file-name "Save articles in file: " - gnus-uu-default-dir gnus-uu-default-dir)))) + gnus-uu-default-dir gnus-uu-default-dir))) + gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-save n file))) @@ -468,7 +476,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive (list current-prefix-arg (read-file-name "Unbinhex, view and save in dir: " - gnus-uu-default-dir gnus-uu-default-dir))) + gnus-uu-default-dir gnus-uu-default-dir)) + gnus-article-mode gnus-summary-mode) (gnus-uu-initialize) (setq gnus-uu-binhex-article-name (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) @@ -480,7 +489,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-digest-mail-forward (&optional n post) "Digests and forwards all articles in this series." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-initialize) (let ((gnus-uu-save-in-digest t) (file (make-temp-file (nnheader-concat gnus-uu-work-dir "forward"))) @@ -546,7 +555,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-digest-post-forward (&optional n) "Digest and forward to a newsgroup." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-digest-mail-forward n t)) ;; Process marking. @@ -576,7 +585,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Set the process mark on articles whose subjects match REGEXP. When called interactively, prompt for REGEXP. Optional UNMARK non-nil means unmark instead of mark." - (interactive "sMark (regexp): \nP") + (interactive "sMark (regexp): \nP" gnus-article-mode gnus-summary-mode) (save-excursion (let* ((articles (gnus-uu-find-articles-matching regexp)) (new-marked (gnus-new-processable unmark articles))) @@ -590,12 +599,12 @@ Optional UNMARK non-nil means unmark instead of mark." (defun gnus-uu-unmark-by-regexp (regexp) "Remove the process mark from articles whose subjects match REGEXP. When called interactively, prompt for REGEXP." - (interactive "sUnmark (regexp): ") + (interactive "sUnmark (regexp): " gnus-article-mode gnus-summary-mode) (gnus-uu-mark-by-regexp regexp t)) (defun gnus-uu-mark-series (&optional silent) "Mark the current series with the process mark." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let* ((articles (gnus-uu-find-articles-matching)) (l (length articles))) (while articles @@ -608,7 +617,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-region (beg end &optional unmark) "Set the process mark on all articles between point and mark." - (interactive "r") + (interactive "r" gnus-article-mode gnus-summary-mode) (save-excursion (goto-char beg) (while (< (point) end) @@ -620,22 +629,22 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-unmark-region (beg end) "Remove the process mark from all articles between point and mark." - (interactive "r") + (interactive "r" gnus-article-mode gnus-summary-mode) (gnus-uu-mark-region beg end t)) (defun gnus-uu-mark-buffer () "Set the process mark on all articles in the buffer." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-uu-mark-region (point-min) (point-max))) (defun gnus-uu-unmark-buffer () "Remove the process mark on all articles in the buffer." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-uu-mark-region (point-min) (point-max) t)) (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-save-hidden-threads (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) @@ -646,7 +655,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-unmark-thread () "Unmarks all articles downwards in this thread." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-remove-process-mark (gnus-summary-article-number)) @@ -656,7 +665,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-invert-processable () "Invert the list of process-marked articles." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((data gnus-newsgroup-data) number) (save-excursion @@ -669,7 +678,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-over (&optional score) "Mark all articles with a score over SCORE (the prefix)." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((score (or score gnus-summary-default-score 0)) (data gnus-newsgroup-data)) (save-excursion @@ -684,7 +693,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-sparse () "Mark all series that have some articles marked." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((marked (nreverse gnus-newsgroup-processable)) subject articles total headers) (unless marked @@ -708,7 +717,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-all () "Mark all articles in \"series\" order." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (setq gnus-newsgroup-processable nil) (save-excursion (let ((data gnus-newsgroup-data) @@ -728,33 +737,33 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-decode-postscript (&optional n) "Gets PostScript of the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article n)) (defun gnus-uu-decode-postscript-view (&optional n) "Gets and views the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-postscript n))) (defun gnus-uu-decode-postscript-and-save (n dir) "Extracts PostScript and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-directory-name "Save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) + (interactive (list current-prefix-arg + (file-name-as-directory + (read-directory-name "Save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir t))) + gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article n dir nil nil t)) (defun gnus-uu-decode-postscript-and-save-view (n dir) "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Where do you want to save the file(s)? " - gnus-uu-default-dir - gnus-uu-default-dir t))) + (interactive (list current-prefix-arg + (read-file-name "Where do you want to save the file(s)? " + gnus-uu-default-dir + gnus-uu-default-dir t)) + gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-postscript-and-save n dir))) diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el index b7e6b2a8890..ec3601109e9 100644 --- a/lisp/gnus/gnus-vm.el +++ b/lisp/gnus/gnus-vm.el @@ -72,7 +72,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) (gnus-summary-save-article arg))) @@ -80,7 +80,7 @@ save those articles instead." (declare-function vm-save-message "ext:vm-save" (folder &optional count)) (defun gnus-summary-save-in-vm (&optional folder) - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (require 'vm) (setq folder (gnus-read-save-file-name diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 7b94c64ae7b..0334b81f0be 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2513,7 +2513,7 @@ are always t.") '(("info" :interactive t Info-goto-node) ("qp" quoted-printable-decode-region quoted-printable-decode-string) ("ps-print" ps-print-preprint) - ("message" :interactive t + ("message" :interactive (message-mode) message-send-and-exit message-yank-original) ("babel" babel-as-string) ("nnmail" nnmail-split-fancy nnmail-article-group) @@ -2530,7 +2530,7 @@ are always t.") ("score-mode" :interactive t gnus-score-mode) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) - ("gnus-mh" :interactive t gnus-summary-save-in-folder) + ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder) ("gnus-demon" gnus-demon-add-scanmail gnus-demon-add-rescan gnus-demon-add-scan-timestamps gnus-demon-add-disconnection gnus-demon-add-handler @@ -2545,7 +2545,7 @@ are always t.") ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info gnus-server-server-name) ("gnus-srvr" gnus-browse-foreign-server) - ("gnus-cite" :interactive t + ("gnus-cite" :interactive (gnus-article-mode gnus-summary-mode) gnus-article-highlight-citation gnus-article-hide-citation-maybe gnus-article-hide-citation gnus-article-fill-cited-article gnus-article-hide-citation-in-followups @@ -2561,29 +2561,34 @@ are always t.") gnus-cache-enter-remove-article gnus-cached-article-p gnus-cache-open gnus-cache-close gnus-cache-update-article gnus-cache-articles-in-group) - ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article + ("gnus-cache" :interactive (gnus-summary-mode) + gnus-summary-insert-cached-articles gnus-cache-enter-article gnus-cache-remove-article gnus-summary-insert-cached-articles) + ("gnus-cache" :interactive t gnus-jog-cache) ("gnus-score" :interactive t + gnus-score-flush-cache gnus-score-close) + ("gnus-score" :interactive (gnus-summary-mode) gnus-summary-increase-score gnus-summary-set-score gnus-summary-raise-thread gnus-summary-raise-same-subject gnus-summary-raise-score gnus-summary-raise-same-subject-and-select gnus-summary-lower-thread gnus-summary-lower-same-subject gnus-summary-lower-score gnus-summary-lower-same-subject-and-select gnus-summary-current-score gnus-score-delta-default - gnus-score-flush-cache gnus-score-close gnus-possibly-score-headers gnus-score-followup-article gnus-score-followup-thread) ("gnus-score" (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers gnus-current-score-file-nondirectory gnus-score-adaptive gnus-score-find-trace gnus-score-file-name) - ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize) - ("gnus-topic" :interactive t gnus-topic-mode) + ("gnus-cus" :interactive (gnus-group-mode) gnus-group-customize) + ("gnus-cus" :interactive (gnus-summary-mode) gnus-score-customize) + ("gnus-topic" :interactive (gnus-group-mode) gnus-topic-mode) ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters gnus-subscribe-topics) - ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) + ("gnus-salt" :interactive (gnus-summary-mode) + gnus-pick-mode gnus-binary-mode) ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) - ("gnus-uu" :interactive t + ("gnus-uu" :interactive (gnus-article-mode gnus-summary-mode) gnus-uu-digest-mail-forward gnus-uu-digest-post-forward gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer gnus-uu-mark-by-regexp gnus-uu-mark-all @@ -2598,12 +2603,13 @@ are always t.") ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) - ("gnus-msg" :interactive t - gnus-group-post-news gnus-group-mail gnus-group-news + ("gnus-msg" :interactive (gnus-group-mode) + gnus-group-post-news gnus-group-mail gnus-group-news) + ("gnus-msg" :interactive (gnus-summary-mode) gnus-summary-post-news gnus-summary-news-other-window gnus-summary-followup gnus-summary-followup-with-original gnus-summary-cancel-article gnus-summary-supersede-article - gnus-post-news gnus-summary-reply gnus-summary-reply-with-original + gnus-summary-reply gnus-summary-reply-with-original gnus-summary-mail-forward gnus-summary-mail-other-window gnus-summary-resend-message gnus-summary-resend-bounced-mail gnus-summary-wide-reply gnus-summary-followup-to-mail @@ -2611,7 +2617,9 @@ are always t.") gnus-summary-wide-reply-with-original gnus-summary-post-forward gnus-summary-wide-reply-with-original gnus-summary-post-forward) - ("gnus-picon" :interactive t gnus-treat-from-picon) + ("gnus-msg" gnus-post-news) + ("gnus-picon" :interactive (gnus-article-mode gnus-summary-mode) + gnus-treat-from-picon) ("smiley" :interactive t smiley-region) ("gnus-win" gnus-configure-windows gnus-add-configuration) ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group @@ -2634,7 +2642,7 @@ are always t.") gnus-request-article-this-buffer gnus-article-mode gnus-article-setup-buffer gnus-narrow-to-page gnus-article-delete-invisible-text gnus-treat-article) - ("gnus-art" :interactive t + ("gnus-art" :interactive (gnus-summary-mode gnus-article-mode) gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-remove-cr gnus-article-remove-trailing-blank-lines @@ -2646,7 +2654,6 @@ are always t.") gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed - ;;gnus-article-show-all-headers gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done gnus-article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer @@ -2671,12 +2678,13 @@ are always t.") gnus-agent-store-article gnus-agent-group-covered-p) ("gnus-agent" :interactive t gnus-unplugged gnus-agentize gnus-agent-batch) - ("gnus-vm" :interactive t gnus-summary-save-in-vm + ("gnus-vm" :interactive (gnus-summary-mode) gnus-summary-save-in-vm gnus-summary-save-article-vm) ("compface" uncompface) - ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue) + ("gnus-draft" :interactive (gnus-summary-mode) gnus-draft-mode) + ("gnus-draft" :interactive t gnus-group-send-queue) ("gnus-mlspl" gnus-group-split gnus-group-split-fancy) - ("gnus-mlspl" :interactive t gnus-group-split-setup + ("gnus-mlspl" :interactive (gnus-group-mode) gnus-group-split-setup gnus-group-split-update) ("gnus-delay" gnus-delay-initialize)))) From 4be98d5575d3c61a941907cd7aaf525409d25caa Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 14:43:24 +0100 Subject: [PATCH 193/297] Fix problem with the newly introduces `minor-modes' variable * lisp/help-fns.el (describe-mode): Apparently buffer-local variables take precedence over lexically bound variables? --- lisp/help-fns.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 0e2c68292c6..ceb6bc09015 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1743,7 +1743,7 @@ documentation for the major and minor modes of that buffer." ;; don't switch buffers before calling `help-buffer'. (with-help-window (help-buffer) (with-current-buffer buffer - (let (minor-modes) + (let (minors) ;; Older packages do not register in minor-mode-list but only in ;; minor-mode-alist. (dolist (x minor-mode-alist) @@ -1766,19 +1766,19 @@ documentation for the major and minor modes of that buffer." fmode))) (push (list fmode pretty-minor-mode (format-mode-line (assq mode minor-mode-alist))) - minor-modes))))) + minors))))) ;; Narrowing is not a minor mode, but its indicator is part of ;; mode-line-modes. (when (buffer-narrowed-p) - (push '(narrow-to-region "Narrow" " Narrow") minor-modes)) - (setq minor-modes - (sort minor-modes + (push '(narrow-to-region "Narrow" " Narrow") minors)) + (setq minors + (sort minors (lambda (a b) (string-lessp (cadr a) (cadr b))))) - (when minor-modes + (when minors (princ "Enabled minor modes:\n") (make-local-variable 'help-button-cache) (with-current-buffer standard-output - (dolist (mode minor-modes) + (dolist (mode minors) (let ((mode-function (nth 0 mode)) (pretty-minor-mode (nth 1 mode)) (indicator (nth 2 mode))) From 9b4a2dde788cae9bb0284027de493f6f207ad56f Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Sun, 14 Feb 2021 15:05:58 +0100 Subject: [PATCH 194/297] ; * doc/lispref/modes.texi: typo fix --- doc/lispref/modes.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 7b8ab4cb4dd..b06cb585069 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1463,7 +1463,7 @@ deactivate minor modes in any order. @defvar minor-modes This buffer-local variable lists the currently enabled minor modes in -the current buffer, and is a list if symbols. +the current buffer, and is a list of symbols. @end defvar @defvar minor-mode-list From 1baadbe060f392253bb4a54ddbdd3870f1d08459 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 16:18:39 +0100 Subject: [PATCH 195/297] Mark up 5x5 for interactive mode --- lisp/play/5x5.el | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 891a5f6cbaa..3630c199bc4 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -179,6 +179,7 @@ GRID is the grid of positions to click.") (define-derived-mode 5x5-mode special-mode "5x5" "A mode for playing `5x5'." + :interactive nil (setq buffer-read-only t truncate-lines t) (buffer-disable-undo)) @@ -221,7 +222,7 @@ Quit current game \\[5x5-quit-game]" (defun 5x5-new-game () "Start a new game of `5x5'." - (interactive) + (interactive nil 5x5-mode) (when (if (called-interactively-p 'interactive) (5x5-y-or-n-p "Start a new game? ") t) (setq 5x5-x-pos (/ 5x5-grid-size 2) @@ -234,7 +235,7 @@ Quit current game \\[5x5-quit-game]" (defun 5x5-quit-game () "Quit the current game of `5x5'." - (interactive) + (interactive nil 5x5-mode) (kill-buffer 5x5-buffer-name)) (defun 5x5-make-new-grid () @@ -782,7 +783,7 @@ Solutions are sorted from least to greatest Hamming weight." Argument N is ignored." ;; For the time being n is ignored, the idea was to use some numeric ;; argument to show a limited amount of positions. - (interactive "P") + (interactive "P" 5x5-mode) (5x5-log-init) (let ((solutions (5x5-solver 5x5-grid))) (setq 5x5-solver-output @@ -805,7 +806,7 @@ list. The list of solution is ordered by number of strokes, so rotating left just after calling `5x5-solve-suggest' will show the solution with second least number of strokes, while rotating right will show the solution with greatest number of strokes." - (interactive "P") + (interactive "P" 5x5-mode) (let ((len (length 5x5-solver-output))) (when (>= len 3) (setq n (if (integerp n) n 1) @@ -839,7 +840,7 @@ right will show the solution with greatest number of strokes." If N is not supplied, rotate by 1. Similar to function `5x5-solve-rotate-left' except that rotation is right instead of lest." - (interactive "P") + (interactive "P" 5x5-mode) (setq n (if (integerp n) (- n) -1)) @@ -851,7 +852,7 @@ lest." (defun 5x5-flip-current () "Make a move on the current cursor location." - (interactive) + (interactive nil 5x5-mode) (setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos)) (5x5-made-move) (unless 5x5-cracking @@ -863,61 +864,61 @@ lest." (defun 5x5-up () "Move up." - (interactive) + (interactive nil 5x5-mode) (unless (zerop 5x5-y-pos) (cl-decf 5x5-y-pos) (5x5-position-cursor))) (defun 5x5-down () "Move down." - (interactive) + (interactive nil 5x5-mode) (unless (= 5x5-y-pos (1- 5x5-grid-size)) (cl-incf 5x5-y-pos) (5x5-position-cursor))) (defun 5x5-left () "Move left." - (interactive) + (interactive nil 5x5-mode) (unless (zerop 5x5-x-pos) (cl-decf 5x5-x-pos) (5x5-position-cursor))) (defun 5x5-right () "Move right." - (interactive) + (interactive nil 5x5-mode) (unless (= 5x5-x-pos (1- 5x5-grid-size)) (cl-incf 5x5-x-pos) (5x5-position-cursor))) (defun 5x5-bol () "Move to beginning of line." - (interactive) + (interactive nil 5x5-mode) (setq 5x5-x-pos 0) (5x5-position-cursor)) (defun 5x5-eol () "Move to end of line." - (interactive) + (interactive nil 5x5-mode) (setq 5x5-x-pos (1- 5x5-grid-size)) (5x5-position-cursor)) (defun 5x5-first () "Move to the first cell." - (interactive) + (interactive nil 5x5-mode) (setq 5x5-x-pos 0 5x5-y-pos 0) (5x5-position-cursor)) (defun 5x5-last () "Move to the last cell." - (interactive) + (interactive nil 5x5-mode) (setq 5x5-x-pos (1- 5x5-grid-size) 5x5-y-pos (1- 5x5-grid-size)) (5x5-position-cursor)) (defun 5x5-randomize () "Randomize the grid." - (interactive) + (interactive nil 5x5-mode) (when (5x5-y-or-n-p "Start a new game with a random grid? ") (setq 5x5-x-pos (/ 5x5-grid-size 2) 5x5-y-pos (/ 5x5-grid-size 2) From 2f00a3435a05bbcedbf8851baeefd33463bc525b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 16:51:14 +0100 Subject: [PATCH 196/297] Don't update `minor-modes' in global modes * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): There's no point in setting the buffer-local `minor-modes' in global modes. --- lisp/emacs-lisp/easy-mmode.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 7e5e2a9b8a9..5ba0d2187f2 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -330,10 +330,11 @@ or call the function `%s'.")))) nil) (t t))) - ;; Keep `minor-modes' up to date. - (setq minor-modes (delq ',modefun minor-modes)) - (when ,getter - (push ',modefun minor-modes)) + (unless ,globalp + ;; Keep `minor-modes' up to date. + (setq minor-modes (delq ',modefun minor-modes)) + (when ,getter + (push ',modefun minor-modes))) ,@body ;; The on/off hooks are here for backward compatibility only. (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) From 0334ac671c228bc967cff6a37c335f04491dd0e7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 16:55:37 +0100 Subject: [PATCH 197/297] Also mention `M-o M-o' removal * lisp/loadup.el (facemenu-keymap-restore): Also restore `M-o M-o'. --- etc/NEWS | 5 ++++- lisp/loadup.el | 3 ++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 22c320bfa31..c58587f12b1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2083,11 +2083,14 @@ first). * Incompatible Editing Changes in Emacs 28.1 -** The 'M-o' ('facemanu-keymap') global binding has been removed. +** The 'M-o' ('facemenu-keymap') global binding has been removed. ** The 'M-o M-s' and 'M-o M-S' global bindings have been removed. Use 'M-x center-line' and 'M-x center-paragraph' instead. +** The 'M-o M-o global binding have been removed. +Use 'M-x font-lock-fontify-block' instead. + ** In 'f90-mode', the backslash character ('\') no longer escapes. For about a decade, the backslash character has no longer had a special escape syntax in Fortran F90. To get the old behaviour back, diff --git a/lisp/loadup.el b/lisp/loadup.el index c91c00a1075..d60aa2ead2a 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -496,7 +496,8 @@ lost after dumping"))) (define-key global-map [C-down-mouse-2] 'facemenu-menu) (define-key global-map "\M-o" 'facemenu-keymap) (define-key facemenu-keymap "\eS" 'center-paragraph) - (define-key facemenu-keymap "\es" 'center-line)) + (define-key facemenu-keymap "\es" 'center-line) + (define-key facemenu-keymap "\M-o" 'font-lock-fontify-block)) (if dump-mode From aa3a48510b9f3397af6afdcde899ec85c6cb27fe Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 16:57:05 +0100 Subject: [PATCH 198/297] Fix missing ' in NEWS --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index c58587f12b1..33434d598ab 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2088,7 +2088,7 @@ first). ** The 'M-o M-s' and 'M-o M-S' global bindings have been removed. Use 'M-x center-line' and 'M-x center-paragraph' instead. -** The 'M-o M-o global binding have been removed. +** The 'M-o M-o' global binding have been removed. Use 'M-x font-lock-fontify-block' instead. ** In 'f90-mode', the backslash character ('\') no longer escapes. From c3396917725a537e9060f2144b6907ab870b22dd Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 18:01:06 +0100 Subject: [PATCH 199/297] Fix byte-run--set-modes call signature * lisp/emacs-lisp/byte-run.el (byte-run--set-modes): We take a list of modes, not a single one (and fix the quoting). --- lisp/emacs-lisp/byte-run.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 30fcbf2b9cc..48a7fe80615 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -149,10 +149,10 @@ The return value of this function is not used." ''completion-predicate val))) (defalias 'byte-run--set-modes - #'(lambda (f _args val) + #'(lambda (f _args &rest val) (list 'function-put (list 'quote f) ''completion-predicate `(lambda (_ b) - (completion-with-modes-p ,val b))))) + (completion-with-modes-p ',val b))))) ;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist From d6bfa30860358c54b689e2e82d8c8d59b424ac45 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 18:14:36 +0100 Subject: [PATCH 200/297] Do command markup in blackbox.el --- lisp/play/blackbox.el | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el index 61b0878b1c5..13bcdcc8595 100644 --- a/lisp/play/blackbox.el +++ b/lisp/play/blackbox.el @@ -274,45 +274,45 @@ a reflection." )) (defun bb-right (count) - (interactive "p") + (interactive "p" blackbox-mode) (while (and (> count 0) (< bb-x 8)) (forward-char 2) (setq bb-x (1+ bb-x)) (setq count (1- count)))) (defun bb-left (count) - (interactive "p") + (interactive "p" blackbox-mode) (while (and (> count 0) (> bb-x -1)) (backward-char 2) (setq bb-x (1- bb-x)) (setq count (1- count)))) (defun bb-up (count) - (interactive "p") + (interactive "p" blackbox-mode) (while (and (> count 0) (> bb-y -1)) (with-no-warnings (previous-line)) (setq bb-y (1- bb-y)) (setq count (1- count)))) (defun bb-down (count) - (interactive "p") + (interactive "p" blackbox-mode) (while (and (> count 0) (< bb-y 8)) (with-no-warnings (next-line)) (setq bb-y (1+ bb-y)) (setq count (1- count)))) (defun bb-eol () - (interactive) + (interactive nil blackbox-mode) (setq bb-x 8) (bb-goto (cons bb-x bb-y))) (defun bb-bol () - (interactive) + (interactive nil blackbox-mode) (setq bb-x -1) (bb-goto (cons bb-x bb-y))) (defun bb-romp () - (interactive) + (interactive nil blackbox-mode) (cond ((and (or (= bb-x -1) (= bb-x 8)) @@ -379,7 +379,7 @@ a reflection." (defun bb-done () "Finish the game and report score." - (interactive) + (interactive nil blackbox-mode) (let (bogus-balls) (cond ((not (= (length bb-balls-placed) (length bb-board))) From 27eaf37241221a5a37f3d628ac247ac0a039cdb5 Mon Sep 17 00:00:00 2001 From: Bastian Beranek Date: Mon, 8 Feb 2021 18:12:33 +0100 Subject: [PATCH 201/297] Fix showing and hiding of tab-bar on new frames (bug#46299) * lisp/tab-bar.el (tab-bar--update-tab-bar-lines) (tab-bar--tab-bar-lines-for-frame): New functions to update value of tab-bar-lines in frames. (tab-bar-mode, tab-bar-new-tab-to, tab-bar-close-tab) (tab-bar-close-other-tab, tab-bar-show :set): Use new function. (tab-bar-select-tab-modifiers :set): Work around visual glitch. --- lisp/tab-bar.el | 95 +++++++++++++++++++++++++++---------------------- 1 file changed, 52 insertions(+), 43 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 6720d82b471..4e47ae2c10e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -89,8 +89,9 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and :set (lambda (sym val) (set-default sym val) ;; Reenable the tab-bar with new keybindings - (tab-bar-mode -1) - (tab-bar-mode 1)) + (when tab-bar-mode + (tab-bar-mode -1) + (tab-bar-mode 1))) :group 'tab-bar :version "27.1") @@ -134,21 +135,47 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and :ascent center)) tab-bar-close-button))) +(defun tab-bar--tab-bar-lines-for-frame (frame) + "Determine and return the value of `tab-bar-lines' for FRAME. +Return 0 if `tab-bar-mode' is not enabled. Otherwise return +either 1 or 0 depending on the value of the customizable variable +`tab-bar-show', which see." + (cond + ((not tab-bar-mode) 0) + ((not tab-bar-show) 0) + ((eq tab-bar-show t) 1) + ((natnump tab-bar-show) + (if (> (length (funcall tab-bar-tabs-function frame)) tab-bar-show) 1 0)))) + +(defun tab-bar--update-tab-bar-lines (&optional frames) + "Update the `tab-bar-lines' parameter in frames. +Update the tab-bar-lines frame parameter. If the optional +parameter FRAMES is omitted, update only the currently selected +frame. If it is `t', update all frames as well as the default +for new frames. Otherwise FRAMES should be a list of frames to +update." + (let ((frame-lst (cond ((null frames) + (list (selected-frame))) + ((eq frames t) + (frame-list)) + (t frames)))) + ;; Loop over all frames and update default-frame-alist + (dolist (frame frame-lst) + (set-frame-parameter frame 'tab-bar-lines (tab-bar--tab-bar-lines-for-frame frame)))) + (when (eq frames t) + (setq default-frame-alist + (cons (cons 'tab-bar-lines (if (and tab-bar-mode (eq tab-bar-show t)) 1 0)) + (assq-delete-all 'tab-bar-lines default-frame-alist))))) + (define-minor-mode tab-bar-mode "Toggle the tab bar in all graphical frames (Tab Bar mode)." :global t ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. :variable tab-bar-mode - (let ((val (if tab-bar-mode 1 0))) - (dolist (frame (frame-list)) - (set-frame-parameter frame 'tab-bar-lines val)) - ;; If the user has given `default-frame-alist' a `tab-bar-lines' - ;; parameter, replace it. - (if (assq 'tab-bar-lines default-frame-alist) - (setq default-frame-alist - (cons (cons 'tab-bar-lines val) - (assq-delete-all 'tab-bar-lines - default-frame-alist))))) + + ;; Recalculate tab-bar-lines for all frames + (tab-bar--update-tab-bar-lines t) + (when tab-bar-mode (tab-bar--load-buttons)) (if tab-bar-mode @@ -250,17 +277,9 @@ you can use the command `toggle-frame-tab-bar'." :initialize 'custom-initialize-default :set (lambda (sym val) (set-default sym val) - ;; Preload button images - (tab-bar-mode 1) - ;; Then handle each frame individually - (dolist (frame (frame-list)) - (set-frame-parameter - frame 'tab-bar-lines - (if (or (eq val t) - (and (natnump val) - (> (length (funcall tab-bar-tabs-function frame)) - val))) - 1 0)))) + (if val + (tab-bar-mode 1) + (tab-bar--update-tab-bar-lines t))) :group 'tab-bar :version "27.1") @@ -852,16 +871,12 @@ After the tab is created, the hooks in (run-hook-with-args 'tab-bar-tab-post-open-functions (nth to-index tabs))) - (cond - ((eq tab-bar-show t) - (tab-bar-mode 1)) - ((and (natnump tab-bar-show) - (> (length (funcall tab-bar-tabs-function)) tab-bar-show) - (zerop (frame-parameter nil 'tab-bar-lines))) - (progn - (tab-bar--load-buttons) - (tab-bar--define-keys) - (set-frame-parameter nil 'tab-bar-lines 1)))) + (when tab-bar-show + (if (not tab-bar-mode) + ;; Switch on tab-bar-mode, since a tab was created + ;; Note: This also updates tab-bar-lines + (tab-bar-mode 1) + (tab-bar--update-tab-bar-lines))) (force-mode-line-update) (unless tab-bar-mode @@ -996,11 +1011,8 @@ for the last tab on a frame is determined by tab-bar-closed-tabs) (set-frame-parameter nil 'tabs (delq close-tab tabs))) - (when (and (not (zerop (frame-parameter nil 'tab-bar-lines))) - (natnump tab-bar-show) - (<= (length (funcall tab-bar-tabs-function)) - tab-bar-show)) - (set-frame-parameter nil 'tab-bar-lines 0)) + ;; Recalculate tab-bar-lines and update frames + (tab-bar--update-tab-bar-lines) (force-mode-line-update) (unless tab-bar-mode @@ -1036,11 +1048,8 @@ for the last tab on a frame is determined by (run-hook-with-args 'tab-bar-tab-pre-close-functions (nth index tabs) nil))) (set-frame-parameter nil 'tabs (list (nth current-index tabs))) - (when (and (not (zerop (frame-parameter nil 'tab-bar-lines))) - (natnump tab-bar-show) - (<= (length (funcall tab-bar-tabs-function)) - tab-bar-show)) - (set-frame-parameter nil 'tab-bar-lines 0)) + ;; Recalculate tab-bar-lines and update frames + (tab-bar--update-tab-bar-lines) (force-mode-line-update) (unless tab-bar-mode From 02869b6c67d90ba5e75d37e9a83de9c831898fbc Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 20:24:23 +0100 Subject: [PATCH 202/297] Make completion-with-modes-p work with minor modes, too * lisp/simple.el (completion-with-modes-p): Work with minor modes, too. --- lisp/simple.el | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 015fa9e4d55..02d3b7df5f6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1974,7 +1974,7 @@ This function uses the `read-extended-command-predicate' user option." (defun completion-in-mode-p (symbol buffer) "Say whether SYMBOL should be offered as a completion. This is true if the command is applicable to the major mode in -BUFFER." +BUFFER, or any of the active minor modes in BUFFER." (or (null (command-modes symbol)) ;; It's derived from a major mode. (apply #'provided-mode-derived-p @@ -1986,9 +1986,16 @@ BUFFER." #'eq))) (defun completion-with-modes-p (modes buffer) - (apply #'provided-mode-derived-p - (buffer-local-value 'major-mode buffer) - modes)) + "Say whether MODES are in action in BUFFER. +This is the case if either the major mode is derived from one of MODES, +or (if one of MODES is a minor mode), if it is switched on in BUFFER." + (or (apply #'provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + modes) + ;; It's a minor mode. + (seq-intersection modes + (buffer-local-value 'minor-modes buffer) + #'eq))) (defun read-extended-command--affixation (command-names) (with-selected-window (or (minibuffer-selected-window) (selected-window)) From f02c93ae7a4f627f5bc37a8cf0cd70cffc4b7bb7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 20:34:03 +0100 Subject: [PATCH 203/297] Add a possible completion predicate for buttons * lisp/simple.el (completion-at-point-p): New predicate. * lisp/net/shr.el (shr-show-alt-text): Mark up as a button. --- lisp/net/shr.el | 1 + lisp/simple.el | 6 ++++++ 2 files changed, 7 insertions(+) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 9c3740fccc9..2596a348384 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -434,6 +434,7 @@ Value is a pair of positions (START . END) if there is a non-nil (defun shr-show-alt-text () "Show the ALT text of the image under point." + (declare (completion 'completion-at-point-p)) (interactive) (let ((text (get-text-property (point) 'shr-alt))) (if (not text) diff --git a/lisp/simple.el b/lisp/simple.el index 02d3b7df5f6..a547417d7ef 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1997,6 +1997,12 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER." (buffer-local-value 'minor-modes buffer) #'eq))) +(defun completion-at-point-p (symbol buffer) + "Return non-nil if SYMBOL is in a local map at point in BUFFER." + (with-current-buffer buffer + (when-let ((map (get-text-property (point) 'keymap))) + (where-is-internal symbol map)))) + (defun read-extended-command--affixation (command-names) (with-selected-window (or (minibuffer-selected-window) (selected-window)) (mapcar From 1c229d939b09b6725824ace1c510739a1910ac87 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 14 Feb 2021 22:11:05 +0200 Subject: [PATCH 204/297] * src/xdisp.c (move_it_to): Fix last change. (Bug#46316) --- src/xdisp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index a1956824214..f86d3527b3d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10051,7 +10051,8 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos if ((op & MOVE_TO_POS) != 0 && (IT_CHARPOS (*it) > to_charpos || (IT_CHARPOS (*it) == to_charpos - && to_charpos == ZV))) + && to_charpos == ZV + && FETCH_BYTE (ZV_BYTE - 1) != '\n'))) { reached = 9; goto out; From 58b9e84a3188837b9a4d45ecccc20bb9f259e278 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Feb 2021 22:57:19 +0100 Subject: [PATCH 205/297] Add a comment to `read-extended-command' * lisp/simple.el (read-extended-command): Add a comment. --- lisp/simple.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/simple.el b/lisp/simple.el index a547417d7ef..44a9c4dc985 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1966,6 +1966,9 @@ This function uses the `read-extended-command-predicate' user option." (complete-with-action action obarray string pred))) (lambda (sym) (and (commandp sym) + ;;; FIXME: This should also be possible to disable by + ;;; the user, but I'm not quite sure what the right + ;;; design for that would look like. (if (get sym 'completion-predicate) (funcall (get sym 'completion-predicate) sym buffer) (funcall read-extended-command-predicate sym buffer)))) From 875ba6f7e79d6d9416e8661213fed362dc182e3f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 14 Feb 2021 21:37:23 +0100 Subject: [PATCH 206/297] Mark up bookmark.el for correct modes * lisp/bookmark.el: Mark up all commands with applicable modes. --- lisp/bookmark.el | 56 ++++++++++++++++++++++++------------------------ 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index dcf8ff0d0af..5cdde258e0b 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -953,7 +953,7 @@ When you have finished composing, type \\[bookmark-send-edited-annotation]. (defun bookmark-send-edited-annotation () "Use buffer contents as annotation for a bookmark. Lines beginning with `#' are ignored." - (interactive) + (interactive nil bookmark-edit-annotation-mode) (if (not (derived-mode-p 'bookmark-edit-annotation-mode)) (error "Not in bookmark-edit-annotation-mode")) (goto-char (point-min)) @@ -1827,7 +1827,7 @@ This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." (defun bookmark-bmenu-toggle-filenames (&optional show) "Toggle whether filenames are shown in the bookmark list. Optional argument SHOW means show them unconditionally." - (interactive) + (interactive nil bookmark-bmenu-mode) (cond (show (setq bookmark-bmenu-toggle-filenames t)) @@ -1912,14 +1912,14 @@ If the annotation does not exist, do nothing." (defun bookmark-bmenu-mark () "Mark bookmark on this line to be displayed by \\\\[bookmark-bmenu-select]." - (interactive) + (interactive nil bookmark-bmenu-mode) (bookmark-bmenu-ensure-position) (tabulated-list-put-tag ">" t)) (defun bookmark-bmenu-mark-all () "Mark all listed bookmarks to be displayed by \\\\[bookmark-bmenu-select]." - (interactive) + (interactive nil bookmark-bmenu-mode) (save-excursion (goto-char (point-min)) (bookmark-bmenu-ensure-position) @@ -1930,7 +1930,7 @@ If the annotation does not exist, do nothing." (defun bookmark-bmenu-select () "Select this line's bookmark; also display bookmarks marked with `>'. You can mark bookmarks with the \\\\[bookmark-bmenu-mark] or \\\\[bookmark-bmenu-mark-all] commands." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bmrk (bookmark-bmenu-bookmark)) (menu (current-buffer)) (others ()) @@ -1975,7 +1975,7 @@ You can mark bookmarks with the \\\\[bookmark-bmenu-mar (defun bookmark-bmenu-save () "Save the current list into a bookmark file. With a prefix arg, prompts for a file to save them in." - (interactive) + (interactive nil bookmark-bmenu-mode) (save-excursion (save-window-excursion (call-interactively 'bookmark-save) @@ -1984,7 +1984,7 @@ With a prefix arg, prompts for a file to save them in." (defun bookmark-bmenu-load () "Load the bookmark file and rebuild the bookmark menu-buffer." - (interactive) + (interactive nil bookmark-bmenu-mode) (bookmark-bmenu-ensure-position) (save-excursion (save-window-excursion @@ -1994,7 +1994,7 @@ With a prefix arg, prompts for a file to save them in." (defun bookmark-bmenu-1-window () "Select this line's bookmark, alone, in full frame." - (interactive) + (interactive nil bookmark-bmenu-mode) (bookmark-jump (bookmark-bmenu-bookmark)) (bury-buffer (other-buffer)) (delete-other-windows)) @@ -2002,7 +2002,7 @@ With a prefix arg, prompts for a file to save them in." (defun bookmark-bmenu-2-window () "Select this line's bookmark, with previous buffer in second window." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bmrk (bookmark-bmenu-bookmark)) (menu (current-buffer)) (pop-up-windows t)) @@ -2014,20 +2014,20 @@ With a prefix arg, prompts for a file to save them in." (defun bookmark-bmenu-this-window () "Select this line's bookmark in this window." - (interactive) + (interactive nil bookmark-bmenu-mode) (bookmark-jump (bookmark-bmenu-bookmark))) (defun bookmark-bmenu-other-window () "Select this line's bookmark in other window, leaving bookmark menu visible." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bookmark (bookmark-bmenu-bookmark))) (bookmark--jump-via bookmark 'switch-to-buffer-other-window))) (defun bookmark-bmenu-other-frame () "Select this line's bookmark in other frame." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bookmark (bookmark-bmenu-bookmark)) (pop-up-frames t)) (bookmark-jump-other-window bookmark))) @@ -2035,7 +2035,7 @@ With a prefix arg, prompts for a file to save them in." (defun bookmark-bmenu-switch-other-window () "Make the other window select this line's bookmark. The current window remains selected." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bookmark (bookmark-bmenu-bookmark)) (fun (lambda (b) (display-buffer b t)))) (bookmark--jump-via bookmark fun))) @@ -2044,7 +2044,7 @@ The current window remains selected." "Jump to bookmark at mouse EVENT position in other window. Move point in menu buffer to the position of EVENT and leave bookmark menu visible." - (interactive "e") + (interactive "e" bookmark-bmenu-mode) (with-current-buffer (window-buffer (posn-window (event-end event))) (save-excursion (goto-char (posn-point (event-end event))) @@ -2053,20 +2053,20 @@ bookmark menu visible." (defun bookmark-bmenu-show-annotation () "Show the annotation for the current bookmark in another window." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bookmark (bookmark-bmenu-bookmark))) (bookmark-show-annotation bookmark))) (defun bookmark-bmenu-show-all-annotations () "Show the annotation for all bookmarks in another window." - (interactive) + (interactive nil bookmark-bmenu-mode) (bookmark-show-all-annotations)) (defun bookmark-bmenu-edit-annotation () "Edit the annotation for the current bookmark in another window." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bookmark (bookmark-bmenu-bookmark))) (bookmark-edit-annotation bookmark t))) @@ -2074,7 +2074,7 @@ bookmark menu visible." (defun bookmark-bmenu-unmark (&optional backup) "Cancel all requested operations on bookmark on this line and move down. Optional BACKUP means move up." - (interactive "P") + (interactive "P" bookmark-bmenu-mode) ;; any flags to reset according to circumstances? How about a ;; flag indicating whether this bookmark is being visited? ;; well, we don't have this now, so maybe later. @@ -2085,7 +2085,7 @@ Optional BACKUP means move up." (defun bookmark-bmenu-backup-unmark () "Move up and cancel all requested operations on bookmark on line above." - (interactive) + (interactive nil bookmark-bmenu-mode) (forward-line -1) (bookmark-bmenu-ensure-position) (bookmark-bmenu-unmark) @@ -2095,7 +2095,7 @@ Optional BACKUP means move up." (defun bookmark-bmenu-unmark-all () "Cancel all requested operations on all listed bookmarks." - (interactive) + (interactive nil bookmark-bmenu-mode) (save-excursion (goto-char (point-min)) (bookmark-bmenu-ensure-position) @@ -2106,7 +2106,7 @@ Optional BACKUP means move up." (defun bookmark-bmenu-delete () "Mark bookmark on this line to be deleted. To carry out the deletions that you've marked, use \\\\[bookmark-bmenu-execute-deletions]." - (interactive) + (interactive nil bookmark-bmenu-mode) (bookmark-bmenu-ensure-position) (tabulated-list-put-tag "D" t)) @@ -2114,7 +2114,7 @@ To carry out the deletions that you've marked, use \\\\ (defun bookmark-bmenu-delete-backwards () "Mark bookmark on this line to be deleted, then move up one line. To carry out the deletions that you've marked, use \\\\[bookmark-bmenu-execute-deletions]." - (interactive) + (interactive nil bookmark-bmenu-mode) (bookmark-bmenu-delete) (forward-line -2)) @@ -2123,7 +2123,7 @@ To carry out the deletions that you've marked, use \\\\ "Mark all listed bookmarks as to be deleted. To remove all deletion marks, use \\\\[bookmark-bmenu-unmark-all]. To carry out the deletions that you've marked, use \\\\[bookmark-bmenu-execute-deletions]." - (interactive) + (interactive nil bookmark-bmenu-mode) (save-excursion (goto-char (point-min)) (bookmark-bmenu-ensure-position) @@ -2133,7 +2133,7 @@ To carry out the deletions that you've marked, use \\\\ (defun bookmark-bmenu-execute-deletions () "Delete bookmarks flagged `D'." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((reporter (make-progress-reporter "Deleting bookmarks...")) (o-point (point)) (o-str (save-excursion @@ -2160,7 +2160,7 @@ To carry out the deletions that you've marked, use \\\\ (defun bookmark-bmenu-rename () "Rename bookmark on current line. Prompts for a new name." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bmrk (bookmark-bmenu-bookmark)) (thispoint (point))) (bookmark-rename bmrk) @@ -2169,14 +2169,14 @@ To carry out the deletions that you've marked, use \\\\ (defun bookmark-bmenu-locate () "Display location of this bookmark. Displays in the minibuffer." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bmrk (bookmark-bmenu-bookmark))) (message "%s" (bookmark-location bmrk)))) (defun bookmark-bmenu-relocate () "Change the absolute file name of the bookmark on the current line. Prompt with completion for the new path." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bmrk (bookmark-bmenu-bookmark)) (thispoint (point))) (bookmark-relocate bmrk) @@ -2196,7 +2196,7 @@ Prompt with completion for the new path." ;;;###autoload (defun bookmark-bmenu-search () "Incremental search of bookmarks, hiding the non-matches as we go." - (interactive) + (interactive nil bookmark-bmenu-mode) (let ((bmk (bookmark-bmenu-bookmark)) (timer nil)) (unwind-protect From f5b172fb6e41e9bf75acd1fd94325a13d75987bf Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 15 Feb 2021 00:43:15 +0100 Subject: [PATCH 207/297] Avoid asking repeatedly about reloading bookmarks file * lisp/bookmark.el (bookmark-maybe-load-default-file): Reload watched bookmarks file only if its mtime has changed since the last query. This avoids asking repeatedly about reloading the bookmarks file if the user has already said "no" to a previous query. (bookmark--watch-file-already-queried-p): New function. (bookmark--watch-already-asked-mtime): New variable. --- lisp/bookmark.el | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 5cdde258e0b..98797a0de2a 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1040,6 +1040,14 @@ it to the name of the bookmark currently being set, advancing (car dired-directory))) (t (error "Buffer not visiting a file or directory"))))) +(defvar bookmark--watch-already-asked-mtime nil + "Mtime for which we already queried about reloading.") + +(defun bookmark--watch-file-already-queried-p (new-mtime) + ;; Don't ask repeatedly if user already said "no" to reloading a + ;; file with this mtime: + (prog1 (equal new-mtime bookmark--watch-already-asked-mtime) + (setq bookmark--watch-already-asked-mtime new-mtime))) (defun bookmark-maybe-load-default-file () "If bookmarks have not been loaded from the default place, load them." @@ -1048,13 +1056,15 @@ it to the name of the bookmark currently being set, advancing (file-readable-p bookmark-default-file) (bookmark-load bookmark-default-file t t))) ((and bookmark-watch-bookmark-file - (not (equal (nth 5 (file-attributes - (car bookmark-bookmarks-timestamp))) - (cdr bookmark-bookmarks-timestamp))) - (or (eq 'silent bookmark-watch-bookmark-file) - (yes-or-no-p - (format "Bookmarks %s changed on disk. Reload? " - (car bookmark-bookmarks-timestamp))))) + (let ((new-mtime (nth 5 (file-attributes + (car bookmark-bookmarks-timestamp)))) + (old-mtime (cdr bookmark-bookmarks-timestamp))) + (and (not (equal new-mtime old-mtime)) + (not (bookmark--watch-file-already-queried-p new-mtime)) + (or (eq 'silent bookmark-watch-bookmark-file) + (yes-or-no-p + (format "Bookmarks %s changed on disk. Reload? " + (car bookmark-bookmarks-timestamp))))))) (bookmark-load (car bookmark-bookmarks-timestamp) t t)))) (defun bookmark-maybe-sort-alist () From b939f7ad359807e846831a9854e0d94260d9f084 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Feb 2021 21:13:35 -0500 Subject: [PATCH 208/297] * Edebug: Generalize `&lookup`, use it for `cl-macrolet` and `cl-generic` This allows the use of (declare (debug ...)) in the lexical macros defined with `cl-macrolet`. It also fixes the names used by Edebug for the methods of `cl-generic` so it doesn't need to use gensym and so they don't include the formal arg names any more. * lisp/emacs-lisp/edebug.el (edebug--match-&-spec-op): Rename from `edebug--handle-&-spec-op`. (edebug--match-&-spec-op <&interpose>): Rename from `&lookup` and generalize so it can let-bind dynamic variables around the rest of the parse. (edebug-lexical-macro-ctx): Rename from `edebug--cl-macrolet-defs` and make it into an alist. (edebug-list-form-args): Use the specs from `edebug-lexical-macro-ctx` when available. (edebug--current-cl-macrolet-defs): Delete var. (edebug-match-cl-macrolet-expr, edebug-match-cl-macrolet-name) (edebug-match-cl-macrolet-body): Delete functions. (def-declarations): Use new `&interpose`. (edebug--match-declare-arg): Rename from `edebug--get-declare-spec` and adjust to new calling convention. * lisp/subr.el (def-edebug-elem-spec): Fix docstring. (eval-after-load): Use `declare`. * lisp/emacs-lisp/cl-generic.el: Fix Edebug names so we don't need gensym any more and we only include the specializers but not the formal arg names. (cl--generic-edebug-name): New var. (cl--generic-edebug-remember-name, cl--generic-edebug-make-name): New funs. (cl-defgeneric, cl-defmethod): Use them. * lisp/emacs-lisp/cl-macs.el: Add support for `debug` declarations in `cl-macrolet`. (cl-declarations-or-string): Fix use of `lambda-doc` and allow use of `declare`. (edebug-lexical-macro-ctx): Declare var. (cl--edebug-macrolet-interposer): New function. (cl-macrolet): Use it to pass the right `lexical-macro-ctx` to the body. * lisp/emacs-lisp/pcase.el (pcase-PAT): Use new `&interpose`. (pcase--edebug-match-pat-args): Rename from `pcase--get-edebug-spec` and adjust to new calling convention. * test/lisp/emacs-lisp/cl-generic-tests.el (cl-defgeneric/edebug/method): Adjust to the new names. * test/lisp/emacs-lisp/edebug-tests.el (edebug-cl-defmethod-qualifier) (edebug-tests-cl-flet): Adjust to the new names. * doc/lispref/edebug.texi (Specification List): Document &interpose. --- doc/lispref/edebug.texi | 22 +-- etc/NEWS | 5 +- lisp/emacs-lisp/cl-generic.el | 76 ++++++---- lisp/emacs-lisp/cl-macs.el | 24 ++- lisp/emacs-lisp/edebug.el | 112 +++++--------- lisp/emacs-lisp/pcase.el | 8 +- lisp/subr.el | 143 +++++++++--------- test/lisp/emacs-lisp/cl-generic-tests.el | 12 +- .../edebug-resources/edebug-test-code.el | 4 +- test/lisp/emacs-lisp/edebug-tests.el | 24 ++- 10 files changed, 217 insertions(+), 213 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 46f5cb9026a..3868f675ead 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1362,16 +1362,20 @@ is primarily used to generate more specific syntax error messages. See edebug-spec; it aborts the instrumentation, displaying the message in the minibuffer. -@item &lookup -Selects a specification based on the code being instrumented. -It takes the form @code{&lookup @var{spec} @var{fun} @var{args...}} +@item &interpose +Lets a function control the parsing of the remaining code. +It takes the form @code{&interpose @var{spec} @var{fun} @var{args...}} and means that Edebug will first match @var{spec} against the code and -then match the rest against the specification returned by calling -@var{fun} with the concatenation of @var{args...} and the code that -matched @code{spec}. For example @code{(&lookup symbolp -pcase--get-edebug-spec)} matches sexps whose first element is -a symbol and whose subsequent elements must obey the spec associated -with that head symbol according to @code{pcase--get-edebug-spec}. +then call @var{fun} with the code that matched @code{spec}, a parsing +function var{pf}, and finally @var{args...}. The parsing +function expects a single argument indicating the specification list +to use to parse the remaining code. It should be called exactly once +and returns the instrumented code that @var{fun} is expected to return. +For example @code{(&interpose symbolp pcase--match-pat-args)} matches +sexps whose first element is a symbol and then lets +@code{pcase--match-pat-args} lookup the specs associated +with that head symbol according to @code{pcase--match-pat-args} and +pass them to the var{pf} it received as argument. @item @var{other-symbol} @cindex indirect specifications diff --git a/etc/NEWS b/etc/NEWS index 33434d598ab..1adfb8c5bb1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -959,7 +959,10 @@ declared obsolete. *** Edebug specification lists can use some new keywords: +++ -**** '&lookup SPEC FUN ARGS...' lets FUN compute the specs to use +**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC. +More specifically, FUN is called with 'HEAD PF ARGS..' where +PF is a parsing function that expects a single argument (the specs to +use) and HEAD is the code that matched SPEC. +++ **** '&error MSG' unconditionally aborts the current edebug instrumentation. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 229608395eb..279b9d137c9 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -189,6 +189,32 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG (setf (cl--generic name) (setq generic (cl--generic-make name)))) generic)) +(defvar cl--generic-edebug-name nil) + +(defun cl--generic-edebug-remember-name (name pf &rest specs) + ;; Remember the name in `cl-defgeneric' so we can use it when building + ;; the names of its `:methods'. + (let ((cl--generic-edebug-name (car name))) + (funcall pf specs))) + +(defun cl--generic-edebug-make-name (in:method _oldname &rest quals-and-args) + ;; The name to use in Edebug for a method: use the generic + ;; function's name plus all its qualifiers and finish with + ;; its specializers. + (pcase-let* + ((basename (if in:method cl--generic-edebug-name (pop quals-and-args))) + (args (car (last quals-and-args))) + (`(,spec-args . ,_) (cl--generic-split-args args)) + (specializers (mapcar (lambda (spec-arg) + (if (eq '&context (car-safe (car spec-arg))) + spec-arg (cdr spec-arg))) + spec-args))) + (format "%s %s" + (mapconcat (lambda (sexp) (format "%s" sexp)) + (cons basename (butlast quals-and-args)) + " ") + specializers))) + ;;;###autoload (defmacro cl-defgeneric (name args &rest options-and-methods) "Create a generic function NAME. @@ -206,31 +232,22 @@ DEFAULT-BODY, if present, is used as the body of a default method. \(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" (declare (indent 2) (doc-string 3) (debug - (&define [&name sexp] ;Allow (setf ...) additionally to symbols. - listp lambda-doc - [&rest [&or - ("declare" &rest sexp) - (":argument-precedence-order" &rest sexp) - (&define ":method" - ;; FIXME: The `gensym' - ;; construct works around - ;; Bug#42672. We'd rather want - ;; names like those generated by - ;; `cl-defmethod', but that - ;; requires larger changes to - ;; Edebug. - [&name "cl-generic-:method@" []] - [&name [] gensym] ;Make it unique! - [&name - [[&rest cl-generic--method-qualifier-p] - ;; FIXME: We don't actually want the - ;; argument's names to be considered - ;; part of the name of the defined - ;; function. - listp]] ;Formal args - lambda-doc - def-body)]] - def-body))) + (&define + &interpose + [&name sexp] ;Allow (setf ...) additionally to symbols. + cl--generic-edebug-remember-name + listp lambda-doc + [&rest [&or + ("declare" &rest sexp) + (":argument-precedence-order" &rest sexp) + (&define ":method" + [&name + [[&rest cl-generic--method-qualifier-p] + listp] ;Formal args + cl--generic-edebug-make-name in:method] + lambda-doc + def-body)]] + def-body))) (let* ((doc (if (stringp (car-safe options-and-methods)) (pop options-and-methods))) (declarations nil) @@ -451,12 +468,9 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (debug (&define ; this means we are defining something [&name [sexp ;Allow (setf ...) additionally to symbols. - ;; Multiple qualifiers are allowed. - [&rest cl-generic--method-qualifier-p] - ;; FIXME: We don't actually want the argument's names - ;; to be considered part of the name of the - ;; defined function. - listp]] ; arguments + [&rest cl-generic--method-qualifier-p] ;qualifiers + listp] ; arguments + cl--generic-edebug-make-name nil] lambda-doc ; documentation string def-body))) ; part to be debugged (let ((qualifiers nil)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index e2faf6df534..b9a8a3f1125 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -190,7 +190,7 @@ The name is made by appending a number to PREFIX, default \"T\"." '(&rest ("cl-declare" &rest sexp))) (def-edebug-elem-spec 'cl-declarations-or-string - '(&or lambda-doc cl-declarations)) + '(lambda-doc &or ("declare" def-declarations) cl-declarations)) (def-edebug-elem-spec 'cl-lambda-list '(([&rest cl-lambda-arg] @@ -2193,6 +2193,20 @@ details. (macroexp-progn body) newenv))))) +(defvar edebug-lexical-macro-ctx) + +(defun cl--edebug-macrolet-interposer (bindings pf &rest specs) + ;; (cl-assert (null (cdr bindings))) + (setq bindings (car bindings)) + (let ((edebug-lexical-macro-ctx + (nconc (mapcar (lambda (binding) + (cons (car binding) + (when (eq 'declare (car-safe (nth 2 binding))) + (nth 1 (assq 'debug (cdr (nth 2 binding))))))) + bindings) + edebug-lexical-macro-ctx))) + (funcall pf specs))) + ;; The following ought to have a better definition for use with newer ;; byte compilers. ;;;###autoload @@ -2202,7 +2216,13 @@ This is like `cl-flet', but for macros instead of functions. \(fn ((NAME ARGLIST BODY...) ...) FORM...)" (declare (indent 1) - (debug (cl-macrolet-expr))) + (debug (&interpose (&rest (&define [&name symbolp "@cl-macrolet@"] + [&name [] gensym] ;Make it unique! + cl-macro-list + cl-declarations-or-string + def-body)) + cl--edebug-macrolet-interposer + cl-declarations body))) (if (cdr bindings) `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body)) (if (null bindings) (macroexp-progn body) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8fadeba6c9a..efca7305fea 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1188,6 +1188,9 @@ purpose by adding an entry to this alist, and setting ;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms) (let ((result (cond + ;; IIUC, `&define' is treated specially here so as to avoid + ;; entering Edebug during the actual function's definition: + ;; we only want to enter Edebug later when the thing is called. (defining-form-p (if (or edebug-all-defs edebug-all-forms) ;; If it is a defining form and we are edebugging defs, @@ -1238,7 +1241,9 @@ purpose by adding an entry to this alist, and setting (defvar edebug-inside-func) ;; whether code is inside function context. ;; Currently def-form sets this to nil; def-body sets it to t. -(defvar edebug--cl-macrolet-defs) ;; Fully defined below. + +(defvar edebug-lexical-macro-ctx nil + "Alist mapping lexically scoped macro names to their debug spec.") (defun edebug-make-enter-wrapper (forms) ;; Generate the enter wrapper for some forms of a definition. @@ -1549,13 +1554,10 @@ contains a circular object." (defsubst edebug-list-form-args (head cursor) ;; Process the arguments of a list form given that head of form is a symbol. ;; Helper for edebug-list-form - (let ((spec (edebug-get-spec head))) + (let* ((lex-spec (assq head edebug-lexical-macro-ctx)) + (spec (if lex-spec (cdr lex-spec) + (edebug-get-spec head)))) (cond - ;; Treat cl-macrolet bindings like macros with no spec. - ((member head edebug--cl-macrolet-defs) - (if edebug-eval-macro-args - (edebug-forms cursor) - (edebug-sexps cursor))) (spec (cond ((consp spec) @@ -1569,7 +1571,7 @@ contains a circular object." ; but leave it in for compatibility. )) ;; No edebug-form-spec provided. - ((macrop head) + ((or lex-spec (macrop head)) (if edebug-eval-macro-args (edebug-forms cursor) (edebug-sexps cursor))) @@ -1689,7 +1691,7 @@ contains a circular object." (first-char (and (symbolp spec) (aref (symbol-name spec) 0))) (match (cond ((eq ?& first-char);; "&" symbols take all following specs. - (edebug--handle-&-spec-op spec cursor (cdr specs))) + (edebug--match-&-spec-op spec cursor (cdr specs))) ((eq ?: first-char);; ":" symbols take one following spec. (setq rest (cdr (cdr specs))) (edebug--handle-:-spec-op spec cursor (car (cdr specs)))) @@ -1731,9 +1733,6 @@ contains a circular object." (def-form . edebug-match-def-form) ;; Less frequently used: ;; (function . edebug-match-function) - (cl-macrolet-expr . edebug-match-cl-macrolet-expr) - (cl-macrolet-name . edebug-match-cl-macrolet-name) - (cl-macrolet-body . edebug-match-cl-macrolet-body) (place . edebug-match-place) (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. @@ -1781,7 +1780,7 @@ contains a circular object." (defsubst edebug-match-body (cursor) (edebug-forms cursor)) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &optional)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs) ;; Keep matching until one spec fails. (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper)) @@ -1807,11 +1806,11 @@ contains a circular object." ;; Reuse the &optional handler with this as the remainder handler. (edebug-&optional-wrapper cursor specs remainder-handler)) -(cl-defgeneric edebug--handle-&-spec-op (op cursor specs) +(cl-defgeneric edebug--match-&-spec-op (op cursor specs) "Handle &foo spec operators. &foo spec operators operate on all the subsequent SPECS.") -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &rest)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs) ;; Repeatedly use specs until failure. (let ((edebug-&rest specs) ;; remember these edebug-best-error @@ -1819,7 +1818,7 @@ contains a circular object." (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper))) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &or)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs) ;; Keep matching until one spec succeeds, and return its results. ;; If none match, fail. ;; This needs to be optimized since most specs spend time here. @@ -1843,40 +1842,48 @@ contains a circular object." (apply #'edebug-no-match cursor "Expected one of" original-specs)) )) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &lookup)) cursor specs) - "Compute the specs for `&lookup SPEC FUN ARGS...'. +(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs) + "Compute the specs for `&interpose SPEC FUN ARGS...'. Extracts the head of the data by matching it against SPEC, -and then matches the rest against the output of (FUN ARGS... HEAD)." +and then matches the rest by calling (FUN HEAD PF ARGS...) +where PF is the parsing function which FUN can call exactly once, +passing it the specs that it needs to match. +Note that HEAD will always be a list, since specs are defined to match +a sequence of elements." (pcase-let* ((`(,spec ,fun . ,args) specs) (exps (edebug-cursor-expressions cursor)) (instrumented-head (edebug-match-one-spec cursor spec)) (consumed (- (length exps) (length (edebug-cursor-expressions cursor)))) - (newspecs (apply fun (append args (seq-subseq exps 0 consumed))))) + (head (seq-subseq exps 0 consumed))) (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps))) - ;; FIXME: What'd be the difference if we used `edebug-match-sublist', - ;; which is what `edebug-list-form-args' uses for the similar purpose - ;; when matching "normal" forms? - (append instrumented-head (edebug-match cursor newspecs)))) + (apply fun `(,head + ,(lambda (newspecs) + ;; FIXME: What'd be the difference if we used + ;; `edebug-match-sublist', which is what + ;; `edebug-list-form-args' uses for the similar purpose + ;; when matching "normal" forms? + (append instrumented-head (edebug-match cursor newspecs))) + ,@args)))) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs) ;; If any specs match, then fail (if (null (catch 'no-match (let ((edebug-gate nil)) (save-excursion - (edebug--handle-&-spec-op '&or cursor specs))) + (edebug--match-&-spec-op '&or cursor specs))) nil)) ;; This means something matched, so it is a no match. (edebug-no-match cursor "Unexpected")) ;; This means nothing matched, so it is OK. nil) ;; So, return nothing -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &key)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs) ;; Following specs must look like ( ) ... ;; where is the name of a keyword, and spec is its spec. ;; This really doesn't save much over the expanded form and takes time. - (edebug--handle-&-spec-op + (edebug--match-&-spec-op '&rest cursor (cons '&or @@ -1885,7 +1892,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." (car (cdr pair)))) specs)))) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &error)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs) ;; Signal an error, using the following string in the spec as argument. (let ((error-string (car specs)) (edebug-error-point (edebug-before-offset cursor))) @@ -1989,7 +1996,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." (defun edebug-match-function (_cursor) (error "Use function-form instead of function in edebug spec")) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &define)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs) ;; Match a defining form. ;; Normally, &define is interpreted specially other places. ;; This should only be called inside of a spec list to match the remainder @@ -2003,7 +2010,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." offsets) specs)) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs) "Compute the name for `&name SPEC FUN` spec operator. The full syntax of that operator is: @@ -2083,43 +2090,6 @@ SPEC is the symbol name prefix for `gensym'." suffix))) nil) -(defvar edebug--cl-macrolet-defs nil - "List of symbols found within the bindings of enclosing `cl-macrolet' forms.") -(defvar edebug--current-cl-macrolet-defs nil - "List of symbols found within the bindings of the current `cl-macrolet' form.") - -(defun edebug-match-cl-macrolet-expr (cursor) - "Match a `cl-macrolet' form at CURSOR." - (let (edebug--current-cl-macrolet-defs) - (edebug-match cursor - '((&rest (&define cl-macrolet-name cl-macro-list - cl-declarations-or-string - def-body)) - cl-declarations cl-macrolet-body)))) - -(defun edebug-match-cl-macrolet-name (cursor) - "Match the name in a `cl-macrolet' binding at CURSOR. -Collect the names in `edebug--cl-macrolet-defs' where they -will be checked by `edebug-list-form-args' and treated as -macros without a spec." - (let ((name (edebug-top-element-required cursor "Expected name"))) - (when (not (symbolp name)) - (edebug-no-match cursor "Bad name:" name)) - ;; Change edebug-def-name to avoid conflicts with - ;; names at global scope. - (setq edebug-def-name (gensym "edebug-anon")) - (edebug-move-cursor cursor) - (push name edebug--current-cl-macrolet-defs) - (list name))) - -(defun edebug-match-cl-macrolet-body (cursor) - "Match the body of a `cl-macrolet' expression at CURSOR. -Put the definitions collected in `edebug--current-cl-macrolet-defs' -into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." - (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs - edebug--cl-macrolet-defs))) - (edebug-match-body cursor))) - (defun edebug-match-arg (cursor) ;; set the def-args bound in edebug-defining-form (let ((edebug-arg (edebug-top-element-required cursor "Expected arg"))) @@ -2210,11 +2180,11 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." )) (put name 'edebug-form-spec spec)) -(defun edebug--get-declare-spec (head) - (get head 'edebug-declaration-spec)) +(defun edebug--match-declare-arg (head pf) + (funcall pf (get (car head) 'edebug-declaration-spec))) (def-edebug-elem-spec 'def-declarations - '(&rest &or (&lookup symbolp edebug--get-declare-spec) sexp)) + '(&rest &or (&interpose symbolp edebug--match-declare-arg) sexp)) (def-edebug-elem-spec 'lambda-list '(([&rest arg] diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 5d428ac846a..d3928fa5051 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -63,7 +63,7 @@ (defvar pcase--dontwarn-upats '(pcase--dontcare)) (def-edebug-elem-spec 'pcase-PAT - '(&or (&lookup symbolp pcase--get-edebug-spec) sexp)) + '(&or (&interpose symbolp pcase--edebug-match-pat-args) sexp)) (def-edebug-elem-spec 'pcase-FUN '(&or lambda-expr @@ -73,7 +73,9 @@ ;; Only called from edebug. (declare-function edebug-get-spec "edebug" (symbol)) -(defun pcase--get-edebug-spec (head) +(defun pcase--edebug-match-pat-args (head pf) + ;; (cl-assert (null (cdr head))) + (setq head (car head)) (or (alist-get head '((quote sexp) (or &rest pcase-PAT) (and &rest pcase-PAT) @@ -81,7 +83,7 @@ (pred &or ("not" pcase-FUN) pcase-FUN) (app pcase-FUN pcase-PAT))) (let ((me (pcase--get-macroexpander head))) - (and me (symbolp me) (edebug-get-spec me))))) + (funcall pf (and me (symbolp me) (edebug-get-spec me)))))) (defun pcase--get-macroexpander (s) "Return the macroexpander for pcase pattern head S, or nil" diff --git a/lisp/subr.el b/lisp/subr.el index d215bd29a91..490aec93f19 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -64,8 +64,8 @@ For more information, see Info node `(elisp)Declaring Functions'." ;;;; Basic Lisp macros. -(defalias 'not 'null) -(defalias 'sxhash 'sxhash-equal) +(defalias 'not #'null) +(defalias 'sxhash #'sxhash-equal) (defmacro noreturn (form) "Evaluate FORM, expecting it not to return. @@ -93,10 +93,7 @@ Info node `(elisp)Specification List' for details." (defun def-edebug-elem-spec (name spec) "Define a new Edebug spec element NAME as shorthand for SPEC. -The SPEC has to be a list or a symbol. -The elements of the list describe the argument types; see -Info node `(elisp)Specification List' for details. -If SPEC is a symbol it should name another pre-existing Edebug element." +The SPEC has to be a list." (declare (indent 1)) (when (string-match "\\`[&:]" (symbol-name name)) ;; & and : have special meaning in spec element names. @@ -788,7 +785,7 @@ If TEST is omitted or nil, `equal' is used." (let (found (tail alist) value) (while (and tail (not found)) (let ((elt (car tail))) - (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key) + (when (funcall (or test #'equal) (if (consp elt) (car elt) elt) key) (setq found t value (if (consp elt) (cdr elt) default)))) (setq tail (cdr tail))) value)) @@ -938,14 +935,14 @@ For an approximate inverse of this, see `key-description'." "Make MAP override all normally self-inserting keys to be undefined. Normally, as an exception, digits and minus-sign are set to make prefix args, but optional second arg NODIGITS non-nil treats them like other chars." - (define-key map [remap self-insert-command] 'undefined) + (define-key map [remap self-insert-command] #'undefined) (or nodigits (let (loop) - (define-key map "-" 'negative-argument) + (define-key map "-" #'negative-argument) ;; Make plain numbers do numeric args. (setq loop ?0) (while (<= loop ?9) - (define-key map (char-to-string loop) 'digit-argument) + (define-key map (char-to-string loop) #'digit-argument) (setq loop (1+ loop)))))) (defun make-composed-keymap (maps &optional parent) @@ -982,8 +979,8 @@ a menu, so this function is not useful for non-menu keymaps." (setq key (if (<= (length key) 1) (aref key 0) (setq keymap (lookup-key keymap - (apply 'vector - (butlast (mapcar 'identity key))))) + (apply #'vector + (butlast (mapcar #'identity key))))) (aref key (1- (length key))))) (let ((tail keymap) done inserted) (while (and (not done) tail) @@ -1111,7 +1108,7 @@ Subkeymaps may be modified but are not canonicalized." (push (cons key item) bindings))) map))) ;; Create the new map. - (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt)) + (setq map (funcall (if ranges #'make-keymap #'make-sparse-keymap) prompt)) (dolist (binding ranges) ;; Treat char-ranges specially. FIXME: need to merge as well. (define-key map (vector (car binding)) (cdr binding))) @@ -1750,29 +1747,29 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Alternate names for functions - these are not being phased out. -(defalias 'send-string 'process-send-string) -(defalias 'send-region 'process-send-region) -(defalias 'string= 'string-equal) -(defalias 'string< 'string-lessp) -(defalias 'string> 'string-greaterp) -(defalias 'move-marker 'set-marker) -(defalias 'rplaca 'setcar) -(defalias 'rplacd 'setcdr) -(defalias 'beep 'ding) ;preserve lingual purity -(defalias 'indent-to-column 'indent-to) -(defalias 'backward-delete-char 'delete-backward-char) +(defalias 'send-string #'process-send-string) +(defalias 'send-region #'process-send-region) +(defalias 'string= #'string-equal) +(defalias 'string< #'string-lessp) +(defalias 'string> #'string-greaterp) +(defalias 'move-marker #'set-marker) +(defalias 'rplaca #'setcar) +(defalias 'rplacd #'setcdr) +(defalias 'beep #'ding) ;preserve lingual purity +(defalias 'indent-to-column #'indent-to) +(defalias 'backward-delete-char #'delete-backward-char) (defalias 'search-forward-regexp (symbol-function 're-search-forward)) (defalias 'search-backward-regexp (symbol-function 're-search-backward)) -(defalias 'int-to-string 'number-to-string) -(defalias 'store-match-data 'set-match-data) -(defalias 'chmod 'set-file-modes) -(defalias 'mkdir 'make-directory) +(defalias 'int-to-string #'number-to-string) +(defalias 'store-match-data #'set-match-data) +(defalias 'chmod #'set-file-modes) +(defalias 'mkdir #'make-directory) ;; These are the XEmacs names: -(defalias 'point-at-eol 'line-end-position) -(defalias 'point-at-bol 'line-beginning-position) +(defalias 'point-at-eol #'line-end-position) +(defalias 'point-at-bol #'line-beginning-position) (define-obsolete-function-alias 'user-original-login-name - 'user-login-name "28.1") + #'user-login-name "28.1") ;;;; Hook manipulation functions. @@ -1886,7 +1883,7 @@ one will be removed." (if local "Buffer-local" "Global")) fn-alist nil t) - fn-alist nil nil 'string=))) + fn-alist nil nil #'string=))) (list hook function local))) (or (boundp hook) (set hook nil)) (or (default-boundp hook) (set-default hook nil)) @@ -2098,9 +2095,9 @@ can do the job." (if (cond ((null compare-fn) (member element (symbol-value list-var))) - ((eq compare-fn 'eq) + ((eq compare-fn #'eq) (memq element (symbol-value list-var))) - ((eq compare-fn 'eql) + ((eq compare-fn #'eql) (memql element (symbol-value list-var))) (t (let ((lst (symbol-value list-var))) @@ -2532,7 +2529,7 @@ program before the output is collected. If STATUS-HANDLER is NIL, an error is signalled if the program returns with a non-zero exit status." (with-temp-buffer - (let ((status (apply 'call-process program nil (current-buffer) nil args))) + (let ((status (apply #'call-process program nil (current-buffer) nil args))) (if status-handler (funcall status-handler status) (unless (eq status 0) @@ -2578,7 +2575,7 @@ process." (format "Buffer %S has a running process; kill it? " (buffer-name (current-buffer))))))) -(add-hook 'kill-buffer-query-functions 'process-kill-buffer-query-function) +(add-hook 'kill-buffer-query-functions #'process-kill-buffer-query-function) ;; process plist management @@ -2766,7 +2763,7 @@ by doing (clear-string STRING)." (use-local-map read-passwd-map) (setq-local inhibit-modification-hooks nil) ;bug#15501. (setq-local show-paren-mode nil) ;bug#16091. - (add-hook 'post-command-hook 'read-password--hide-password nil t)) + (add-hook 'post-command-hook #'read-password--hide-password nil t)) (unwind-protect (let ((enable-recursive-minibuffers t) (read-hide-char (or read-hide-char ?*))) @@ -2776,8 +2773,8 @@ by doing (clear-string STRING)." ;; Not sure why but it seems that there might be cases where the ;; minibuffer is not always properly reset later on, so undo ;; whatever we've done here (bug#11392). - (remove-hook 'after-change-functions 'read-password--hide-password - 'local) + (remove-hook 'after-change-functions + #'read-password--hide-password 'local) (kill-local-variable 'post-self-insert-hook) ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) @@ -2807,7 +2804,7 @@ This function is used by the `interactive' code letter `n'." prompt nil nil nil (or hist 'read-number-history) (when default (if (consp default) - (mapcar 'number-to-string (delq nil default)) + (mapcar #'number-to-string (delq nil default)) (number-to-string default)))))) (condition-case nil (setq n (cond @@ -2961,13 +2958,13 @@ If there is a natural number at point, use it as default." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) - (define-key map [remap self-insert-command] 'read-char-from-minibuffer-insert-char) + (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char) - (define-key map [remap recenter-top-bottom] 'minibuffer-recenter-top-bottom) - (define-key map [remap scroll-up-command] 'minibuffer-scroll-up-command) - (define-key map [remap scroll-down-command] 'minibuffer-scroll-down-command) - (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window) - (define-key map [remap scroll-other-window-down] 'minibuffer-scroll-other-window-down) + (define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom) + (define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command) + (define-key map [remap scroll-down-command] #'minibuffer-scroll-down-command) + (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window) + (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down) map) "Keymap for the `read-char-from-minibuffer' function.") @@ -3030,9 +3027,9 @@ There is no need to explicitly add `help-char' to CHARS; (help-form-show))))) (dolist (char chars) (define-key map (vector char) - 'read-char-from-minibuffer-insert-char)) + #'read-char-from-minibuffer-insert-char)) (define-key map [remap self-insert-command] - 'read-char-from-minibuffer-insert-other) + #'read-char-from-minibuffer-insert-other) (puthash (list help-form (cons help-char chars)) map read-char-from-minibuffer-map-hash) map)) @@ -3065,26 +3062,26 @@ There is no need to explicitly add `help-char' to CHARS; (set-keymap-parent map minibuffer-local-map) (dolist (symbol '(act act-and-show act-and-exit automatic)) - (define-key map (vector 'remap symbol) 'y-or-n-p-insert-y)) + (define-key map (vector 'remap symbol) #'y-or-n-p-insert-y)) - (define-key map [remap skip] 'y-or-n-p-insert-n) + (define-key map [remap skip] #'y-or-n-p-insert-n) (dolist (symbol '(backup undo undo-all edit edit-replacement delete-and-edit ignore self-insert-command)) - (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other)) + (define-key map (vector 'remap symbol) #'y-or-n-p-insert-other)) - (define-key map [remap recenter] 'minibuffer-recenter-top-bottom) - (define-key map [remap scroll-up] 'minibuffer-scroll-up-command) - (define-key map [remap scroll-down] 'minibuffer-scroll-down-command) - (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window) - (define-key map [remap scroll-other-window-down] 'minibuffer-scroll-other-window-down) + (define-key map [remap recenter] #'minibuffer-recenter-top-bottom) + (define-key map [remap scroll-up] #'minibuffer-scroll-up-command) + (define-key map [remap scroll-down] #'minibuffer-scroll-down-command) + (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window) + (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down) - (define-key map [escape] 'abort-recursive-edit) + (define-key map [escape] #'abort-recursive-edit) (dolist (symbol '(quit exit exit-prefix)) - (define-key map (vector 'remap symbol) 'abort-recursive-edit)) + (define-key map (vector 'remap symbol) #'abort-recursive-edit)) ;; FIXME: try catch-all instead of explicit bindings: - ;; (define-key map [remap t] 'y-or-n-p-insert-other) + ;; (define-key map [remap t] #'y-or-n-p-insert-other) map) "Keymap that defines additional bindings for `y-or-n-p' answers.") @@ -3381,7 +3378,7 @@ This finishes the change group by reverting all of its changes." ;; For compatibility. (define-obsolete-function-alias 'redraw-modeline - 'force-mode-line-update "24.3") + #'force-mode-line-update "24.3") (defun momentary-string-display (string pos &optional exit-char message) "Momentarily display STRING in the buffer at POS. @@ -3525,7 +3522,7 @@ When in a major mode that does not provide its own symbol at point exactly." (let ((tag (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default)))) + #'find-tag-default)))) (if tag (regexp-quote tag)))) (defun find-tag-default-as-symbol-regexp () @@ -3539,8 +3536,8 @@ symbol at point exactly." (if (and tag-regexp (eq (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default) - 'find-tag-default)) + #'find-tag-default) + #'find-tag-default)) (format "\\_<%s\\_>" tag-regexp) tag-regexp))) @@ -3874,7 +3871,7 @@ discouraged." (call-process shell-file-name infile buffer display shell-command-switch - (mapconcat 'identity (cons command args) " "))) + (mapconcat #'identity (cons command args) " "))) (defun process-file-shell-command (command &optional infile buffer display &rest args) @@ -3886,7 +3883,7 @@ Similar to `call-process-shell-command', but calls `process-file'." (with-connection-local-variables (process-file shell-file-name infile buffer display shell-command-switch - (mapconcat 'identity (cons command args) " ")))) + (mapconcat #'identity (cons command args) " ")))) (defun call-shell-region (start end command &optional delete buffer) "Send text from START to END as input to an inferior shell running COMMAND. @@ -4905,8 +4902,8 @@ FILE, a string, is described in the function `eval-after-load'." "" ;; Note: regexp-opt can't be used here, since we need to call ;; this before Emacs has been fully started. 2006-05-21 - (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) - "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") + (concat "\\(" (mapconcat #'regexp-quote load-suffixes "\\|") "\\)?")) + "\\(" (mapconcat #'regexp-quote jka-compr-load-suffixes "\\|") "\\)?\\'")) (defun load-history-filename-element (file-regexp) @@ -4922,7 +4919,6 @@ Return nil if there isn't one." load-elt (and loads (car loads))))) load-elt)) -(put 'eval-after-load 'lisp-indent-function 1) (defun eval-after-load (file form) "Arrange that if FILE is loaded, FORM will be run immediately afterwards. If FILE is already loaded, evaluate FORM right now. @@ -4957,7 +4953,8 @@ like `font-lock'. This function makes or adds to an entry on `after-load-alist'. See also `with-eval-after-load'." - (declare (compiler-macro + (declare (indent 1) + (compiler-macro (lambda (whole) (if (eq 'quote (car-safe form)) ;; Quote with lambda so the compiler can look inside. @@ -5064,7 +5061,7 @@ This function is called directly from the C code." "Display delayed warnings from `delayed-warnings-list'. Used from `delayed-warnings-hook' (which see)." (dolist (warning (nreverse delayed-warnings-list)) - (apply 'display-warning warning)) + (apply #'display-warning warning)) (setq delayed-warnings-list nil)) (defun collapse-delayed-warnings () @@ -5397,7 +5394,7 @@ The properties used on SYMBOL are `composefunc', `sendfunc', `abortfunc', and `hookvar'." (put symbol 'composefunc composefunc) (put symbol 'sendfunc sendfunc) - (put symbol 'abortfunc (or abortfunc 'kill-buffer)) + (put symbol 'abortfunc (or abortfunc #'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) @@ -5562,7 +5559,7 @@ To test whether a function can be called interactively, use (set symbol tail))))) (define-obsolete-function-alias - 'set-temporary-overlay-map 'set-transient-map "24.4") + 'set-temporary-overlay-map #'set-transient-map "24.4") (defun set-transient-map (map &optional keep-pred on-exit) "Set MAP as a temporary keymap taking precedence over other keymaps. @@ -6190,7 +6187,7 @@ returned list are in the same order as in TREE. ;; Technically, `flatten-list' is a misnomer, but we provide it here ;; for discoverability: -(defalias 'flatten-list 'flatten-tree) +(defalias 'flatten-list #'flatten-tree) ;; The initial anchoring is for better performance in searching matches. (defconst regexp-unmatchable "\\`a\\`" diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 4a01623cb88..9312fb44a1e 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -269,9 +269,7 @@ Edebug symbols (Bug#42672)." (when (memq name instrumented-names) (error "Duplicate definition of `%s'" name)) (push name instrumented-names) - (edebug-new-definition name))) - ;; Make generated symbols reproducible. - (gensym-counter 10000)) + (edebug-new-definition name)))) (eval-buffer) (should (equal (reverse instrumented-names) @@ -280,11 +278,11 @@ Edebug symbols (Bug#42672)." ;; FIXME: We'd rather have names such as ;; `cl-defgeneric/edebug/method/1 ((_ number))', but ;; that requires further changes to Edebug. - (list (intern "cl-generic-:method@10000 ((_ number))") - (intern "cl-generic-:method@10001 ((_ string))") - (intern "cl-generic-:method@10002 :around ((_ number))") + (list (intern "cl-defgeneric/edebug/method/1 (number)") + (intern "cl-defgeneric/edebug/method/1 (string)") + (intern "cl-defgeneric/edebug/method/1 :around (number)") 'cl-defgeneric/edebug/method/1 - (intern "cl-generic-:method@10003 ((_ number))") + (intern "cl-defgeneric/edebug/method/2 (number)") 'cl-defgeneric/edebug/method/2)))))) (provide 'cl-generic-tests) diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index 835d3781d09..9257f167d67 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -62,12 +62,12 @@ (defun edebug-test-code-format-vector-node (node) !start!(concat "[" - (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply! + (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply! "]")) (defun edebug-test-code-format-list-node (node) !start!(concat "{" - (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply! + (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply! "}")) (defun edebug-test-code-format-node (node) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index dfe2cb32065..d81376e45ec 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -951,8 +951,8 @@ primary ones (Bug#42671)." (should (equal defined-symbols - (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))") - (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) + (list (intern "edebug-cl-defmethod-qualifier :around (number)") + (intern "edebug-cl-defmethod-qualifier (number)"))))))) (ert-deftest edebug-tests--conflicting-internal-names () "Check conflicts between form's head symbols and Edebug spec elements." @@ -992,23 +992,19 @@ clashes (Bug#41853)." ;; Make generated symbols reproducible. (gensym-counter 10000)) (eval-buffer) - (should (equal (reverse instrumented-names) + ;; Use `format' so as to throw away differences due to + ;; interned/uninterned symbols. + (should (equal (format "%s" (reverse instrumented-names)) ;; The outer definitions come after the inner ;; ones because their body ends later. - ;; FIXME: There are twice as many inner - ;; definitions as expected due to Bug#41988. - ;; Once that bug is fixed, remove the duplicates. ;; FIXME: We'd rather have names such as ;; `edebug-tests-cl-flet-1@inner@cl-flet@10000', ;; but that requires further changes to Edebug. - '(inner@cl-flet@10000 - inner@cl-flet@10001 - inner@cl-flet@10002 - inner@cl-flet@10003 - edebug-tests-cl-flet-1 - inner@cl-flet@10004 - inner@cl-flet@10005 - edebug-tests-cl-flet-2)))))) + (format "%s" '(inner@cl-flet@10000 + inner@cl-flet@10001 + edebug-tests-cl-flet-1 + inner@cl-flet@10002 + edebug-tests-cl-flet-2))))))) (ert-deftest edebug-tests-duplicate-symbol-backtrack () "Check that Edebug doesn't create duplicate symbols when From a81dc34babc76e1fd09a23c9b59cad0ef612a95f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Feb 2021 03:44:15 +0100 Subject: [PATCH 209/297] Fix two syntax errors in Specification List * doc/lispref/edebug.texi (Specification List): Add a couple of missing @s. --- doc/lispref/edebug.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 3868f675ead..8942f55affb 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1367,7 +1367,7 @@ Lets a function control the parsing of the remaining code. It takes the form @code{&interpose @var{spec} @var{fun} @var{args...}} and means that Edebug will first match @var{spec} against the code and then call @var{fun} with the code that matched @code{spec}, a parsing -function var{pf}, and finally @var{args...}. The parsing +function @var{pf}, and finally @var{args...}. The parsing function expects a single argument indicating the specification list to use to parse the remaining code. It should be called exactly once and returns the instrumented code that @var{fun} is expected to return. @@ -1375,7 +1375,7 @@ For example @code{(&interpose symbolp pcase--match-pat-args)} matches sexps whose first element is a symbol and then lets @code{pcase--match-pat-args} lookup the specs associated with that head symbol according to @code{pcase--match-pat-args} and -pass them to the var{pf} it received as argument. +pass them to the @var{pf} it received as argument. @item @var{other-symbol} @cindex indirect specifications From df99b17e4fe7f6ee0c09ac990117ffea6ee3b695 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Feb 2021 04:22:29 +0100 Subject: [PATCH 210/297] Speed up completion-in-mode-p in the common case * lisp/simple.el (completion-in-mode-p): Make predicate more efficient in the common one-mode case. --- lisp/simple.el | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 44a9c4dc985..ed0e753ee06 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1978,15 +1978,20 @@ This function uses the `read-extended-command-predicate' user option." "Say whether SYMBOL should be offered as a completion. This is true if the command is applicable to the major mode in BUFFER, or any of the active minor modes in BUFFER." - (or (null (command-modes symbol)) - ;; It's derived from a major mode. - (apply #'provided-mode-derived-p - (buffer-local-value 'major-mode buffer) - (command-modes symbol)) - ;; It's a minor mode. - (seq-intersection (command-modes symbol) - (buffer-local-value 'minor-modes buffer) - #'eq))) + (let ((modes (command-modes symbol))) + (or (null modes) + ;; Common case: Just a single mode. + (if (null (cdr modes)) + (or (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) (car modes)) + (memq (car modes) (buffer-local-value 'minor-modes buffer))) + ;; Uncommon case: Multiple modes. + (apply #'provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + modes) + (seq-intersection modes + (buffer-local-value 'minor-modes buffer) + #'eq))))) (defun completion-with-modes-p (modes buffer) "Say whether MODES are in action in BUFFER. From 2594162b23f64dc394e8fe4035ea651ed54661ac Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Feb 2021 04:42:32 +0100 Subject: [PATCH 211/297] Make the button completion predicate be more useful * lisp/simple.el (completion-button-p): Rework from `completion-at-point-p'. * lisp/net/shr.el (shr-show-alt-text): It should be possible to complete to commands that aren't bound to a key. --- lisp/net/shr.el | 2 +- lisp/simple.el | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2596a348384..739b56b88c6 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -434,7 +434,7 @@ Value is a pair of positions (START . END) if there is a non-nil (defun shr-show-alt-text () "Show the ALT text of the image under point." - (declare (completion 'completion-at-point-p)) + (declare (completion (lambda (_ b) (completion-button-p 'shr b)))) (interactive) (let ((text (get-text-property (point) 'shr-alt))) (if (not text) diff --git a/lisp/simple.el b/lisp/simple.el index ed0e753ee06..8d27cf8d625 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2005,11 +2005,11 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER." (buffer-local-value 'minor-modes buffer) #'eq))) -(defun completion-at-point-p (symbol buffer) - "Return non-nil if SYMBOL is in a local map at point in BUFFER." +(defun completion-button-p (category buffer) + "Return non-nil if there's a button of CATEGORY at point in BUFFER." (with-current-buffer buffer - (when-let ((map (get-text-property (point) 'keymap))) - (where-is-internal symbol map)))) + (and (get-text-property (point) 'button) + (eq (get-text-property (point) 'category) category)))) (defun read-extended-command--affixation (command-names) (with-selected-window (or (minibuffer-selected-window) (selected-window)) From 623e534e49ad0a360d1291b917ce97515742a3e9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Feb 2021 22:56:08 -0500 Subject: [PATCH 212/297] * lisp/emacs-lisp/byte-run.el (compiler-macro): Make it Edebuggable * lisp/emacs-lisp/gv.el (gc-expander, gv-setter): Reuse the spec of `compiler-macro`. --- lisp/emacs-lisp/byte-run.el | 3 +++ lisp/emacs-lisp/gv.el | 4 +++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 48a7fe80615..8a22388f1d7 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -113,6 +113,9 @@ The return value of this function is not used." (list 'function-put (list 'quote f) ''side-effect-free (list 'quote val)))) +(put 'compiler-macro 'edebug-declaration-spec + '(&or symbolp ("lambda" &define lambda-list lambda-doc def-body))) + (defalias 'byte-run--set-compiler-macro #'(lambda (f args compiler-function) (if (not (eq (car-safe compiler-function) 'lambda)) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 3200b1c3494..cbbed06d7c8 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -188,7 +188,9 @@ arguments as NAME. DO is a function as defined in `gv-get'." defun-declarations-alist)) ;;;###autoload -(let ((spec '(&or symbolp ("lambda" &define lambda-list def-body)))) +(let ((spec (get 'compiler-macro 'edebug-declaration-spec))) + ;; It so happens that it's the same spec for gv-* as for compiler-macros. + ;; '(&or symbolp ("lambda" &define lambda-list lambda-doc def-body)) (put 'gv-expander 'edebug-declaration-spec spec) (put 'gv-setter 'edebug-declaration-spec spec)) From 54e577fbc1fb2e1189388ac290fe70d0f87b6c76 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Feb 2021 23:56:42 -0500 Subject: [PATCH 213/297] * lisp/emacs-lisp/edebug.el (edebug-&optional, edebug-&rest): Remove vars According to my tests, `edebug-&optional` never has any effect. And `edebug-&rest` can be replaced with a closure. (edebug-&rest-wrapper): Remove function. (edebug--match-&-spec-op): Use a closure to remember the `specs`. --- lisp/emacs-lisp/edebug.el | 59 ++++++++++++++++----------------------- 1 file changed, 24 insertions(+), 35 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index efca7305fea..7fae4d21d50 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1091,8 +1091,6 @@ circular objects. Let `read' read everything else." ;; This data is shared by all embedded definitions. (defvar edebug-top-window-data) -(defvar edebug-&optional) -(defvar edebug-&rest) (defvar edebug-gate nil) ;; whether no-match forces an error. (defvar edebug-def-name nil) ; name of definition, used by interactive-form @@ -1143,8 +1141,6 @@ purpose by adding an entry to this alist, and setting edebug-top-window-data edebug-def-name;; make sure it is locally nil ;; I don't like these here!! - edebug-&optional - edebug-&rest edebug-gate edebug-best-error edebug-error-point @@ -1512,6 +1508,9 @@ contains a circular object." ((consp form) ;; The first offset for a list form is for the list form itself. (if (eq 'quote (car form)) + ;; This makes sure we don't instrument 'foo + ;; which would cause the debugger to single-step + ;; the trivial evaluation of a constant. form (let* ((head (car form)) (spec (and (symbolp head) (edebug-get-spec head))) @@ -1584,10 +1583,7 @@ contains a circular object." ;; The after offset will be left in the cursor after processing the form. (let ((head (edebug-top-element-required cursor "Expected elements")) ;; Prevent backtracking whenever instrumenting. - (edebug-gate t) - ;; A list form is never optional because it matches anything. - (edebug-&optional nil) - (edebug-&rest nil)) + (edebug-gate t)) ;; Skip the first offset. (edebug-set-cursor cursor (edebug-cursor-expressions cursor) (cdr (edebug-cursor-offsets cursor))) @@ -1632,7 +1628,7 @@ contains a circular object." (setq edebug-error-point (or edebug-error-point (edebug-before-offset cursor)) edebug-best-error (or edebug-best-error args)) - (if (and edebug-gate (not edebug-&optional)) + (if edebug-gate (progn (if edebug-error-point (goto-char edebug-error-point)) @@ -1643,9 +1639,7 @@ contains a circular object." (defun edebug-match (cursor specs) ;; Top level spec matching function. ;; Used also at each lower level of specs. - (let (edebug-&optional - edebug-&rest - edebug-best-error + (let (edebug-best-error edebug-error-point (edebug-gate edebug-gate) ;; locally bound to limit effect ) @@ -1782,11 +1776,10 @@ contains a circular object." (cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs) ;; Keep matching until one spec fails. - (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper)) + (edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper)) (defun edebug-&optional-wrapper (cursor specs remainder-handler) (let (result - (edebug-&optional specs) (edebug-gate nil) (this-form (edebug-cursor-expressions cursor)) (this-offset (edebug-cursor-offsets cursor))) @@ -1801,21 +1794,21 @@ contains a circular object." nil))) -(defun edebug-&rest-wrapper (cursor specs remainder-handler) - (if (null specs) (setq specs edebug-&rest)) - ;; Reuse the &optional handler with this as the remainder handler. - (edebug-&optional-wrapper cursor specs remainder-handler)) - (cl-defgeneric edebug--match-&-spec-op (op cursor specs) "Handle &foo spec operators. &foo spec operators operate on all the subsequent SPECS.") (cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs) ;; Repeatedly use specs until failure. - (let ((edebug-&rest specs) ;; remember these - edebug-best-error + (let (edebug-best-error edebug-error-point) - (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper))) + ;; Reuse the &optional handler with this as the remainder handler. + (edebug-&optional-wrapper + cursor specs + (lambda (c s rh) + ;; `s' is the remaining spec to match. + ;; When it's nil, start over matching `specs'. + (edebug-&optional-wrapper c (or s specs) rh))))) (cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs) @@ -1961,19 +1954,15 @@ a sequence of elements." (defun edebug-match-sublist (cursor specs) ;; Match a sublist of specs. - (let (edebug-&optional - ;;edebug-best-error - ;;edebug-error-point - ) - (prog1 - ;; match with edebug-match-specs so edebug-best-error is not bound. - (edebug-match-specs cursor specs 'edebug-match-specs) - (if (not (edebug-empty-cursor cursor)) - (if edebug-best-error - (apply #'edebug-no-match cursor edebug-best-error) - ;; A failed &rest or &optional spec may leave some args. - (edebug-no-match cursor "Failed matching" specs) - ))))) + (prog1 + ;; match with edebug-match-specs so edebug-best-error is not bound. + (edebug-match-specs cursor specs 'edebug-match-specs) + (if (not (edebug-empty-cursor cursor)) + (if edebug-best-error + (apply #'edebug-no-match cursor edebug-best-error) + ;; A failed &rest or &optional spec may leave some args. + (edebug-no-match cursor "Failed matching" specs) + )))) (defun edebug-match-string (cursor spec) From 0bd846c17474b161b11fbe21545609cd545b1798 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Feb 2021 12:44:57 +0100 Subject: [PATCH 214/297] Rename minor-modes to local-minor-modes * doc/lispref/modes.texi (Minor Modes): Update documentation. * lisp/simple.el (completion-with-modes-p): Change usage. * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Change usage. * src/buffer.c: Rename from minor_modes to local_minor_modes throughout. (syms_of_buffer): Rename minor-modes to local-minor-modes. * src/buffer.h (struct buffer): Rename minor_modes_. * src/pdumper.c (dump_buffer): Update hash and usage. --- doc/lispref/modes.texi | 2 +- etc/NEWS | 2 +- lisp/emacs-lisp/easy-mmode.el | 6 +++--- lisp/simple.el | 7 ++++--- src/buffer.c | 13 +++++++------ src/buffer.h | 2 +- src/pdumper.c | 4 ++-- 7 files changed, 19 insertions(+), 17 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index b06cb585069..192ffb6a0a9 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1461,7 +1461,7 @@ used only with Diff mode. other minor modes in effect. It should be possible to activate and deactivate minor modes in any order. -@defvar minor-modes +@defvar local-minor-modes This buffer-local variable lists the currently enabled minor modes in the current buffer, and is a list of symbols. @end defvar diff --git a/etc/NEWS b/etc/NEWS index 1adfb8c5bb1..eeaed3b5cfa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2295,7 +2295,7 @@ minor mode activated. Note that using this form will create byte code that is not compatible with byte code in previous Emacs versions. +++ -** New buffer-local variable 'minor-modes'. +** New buffer-local variable 'local-minor-modes'. This permanently buffer-local variable holds a list of currently enabled minor modes in the current buffer (as a list of symbols). diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 5ba0d2187f2..c48ec505ce0 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -331,10 +331,10 @@ or call the function `%s'.")))) (t t))) (unless ,globalp - ;; Keep `minor-modes' up to date. - (setq minor-modes (delq ',modefun minor-modes)) + ;; Keep `local-minor-modes' up to date. + (setq local-minor-modes (delq ',modefun local-minor-modes)) (when ,getter - (push ',modefun minor-modes))) + (push ',modefun local-minor-modes))) ,@body ;; The on/off hooks are here for backward compatibility only. (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) diff --git a/lisp/simple.el b/lisp/simple.el index 8d27cf8d625..cb7496d37c5 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1984,13 +1984,14 @@ BUFFER, or any of the active minor modes in BUFFER." (if (null (cdr modes)) (or (provided-mode-derived-p (buffer-local-value 'major-mode buffer) (car modes)) - (memq (car modes) (buffer-local-value 'minor-modes buffer))) + (memq (car modes) + (buffer-local-value 'local-minor-modes buffer))) ;; Uncommon case: Multiple modes. (apply #'provided-mode-derived-p (buffer-local-value 'major-mode buffer) modes) (seq-intersection modes - (buffer-local-value 'minor-modes buffer) + (buffer-local-value 'local-minor-modes buffer) #'eq))))) (defun completion-with-modes-p (modes buffer) @@ -2002,7 +2003,7 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER." modes) ;; It's a minor mode. (seq-intersection modes - (buffer-local-value 'minor-modes buffer) + (buffer-local-value 'local-minor-modes buffer) #'eq))) (defun completion-button-p (category buffer) diff --git a/src/buffer.c b/src/buffer.c index 487599dbbed..5bd9b37702f 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -292,9 +292,9 @@ bset_major_mode (struct buffer *b, Lisp_Object val) b->major_mode_ = val; } static void -bset_minor_modes (struct buffer *b, Lisp_Object val) +bset_local_minor_modes (struct buffer *b, Lisp_Object val) { - b->minor_modes_ = val; + b->local_minor_modes_ = val; } static void bset_mark (struct buffer *b, Lisp_Object val) @@ -898,7 +898,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) bset_file_truename (b, Qnil); bset_display_count (b, make_fixnum (0)); bset_backed_up (b, Qnil); - bset_minor_modes (b, Qnil); + bset_local_minor_modes (b, Qnil); bset_auto_save_file_name (b, Qnil); set_buffer_internal_1 (b); Fset (intern ("buffer-save-without-query"), Qnil); @@ -973,7 +973,7 @@ reset_buffer (register struct buffer *b) b->clip_changed = 0; b->prevent_redisplay_optimizations_p = 1; bset_backed_up (b, Qnil); - bset_minor_modes (b, Qnil); + bset_local_minor_modes (b, Qnil); BUF_AUTOSAVE_MODIFF (b) = 0; b->auto_save_failure_time = 0; bset_auto_save_file_name (b, Qnil); @@ -5158,7 +5158,7 @@ init_buffer_once (void) bset_auto_save_file_name (&buffer_local_flags, make_fixnum (-1)); bset_read_only (&buffer_local_flags, make_fixnum (-1)); bset_major_mode (&buffer_local_flags, make_fixnum (-1)); - bset_minor_modes (&buffer_local_flags, make_fixnum (-1)); + bset_local_minor_modes (&buffer_local_flags, make_fixnum (-1)); bset_mode_name (&buffer_local_flags, make_fixnum (-1)); bset_undo_list (&buffer_local_flags, make_fixnum (-1)); bset_mark_active (&buffer_local_flags, make_fixnum (-1)); @@ -5625,7 +5625,8 @@ The default value (normally `fundamental-mode') affects new buffers. A value of nil means to use the current buffer's major mode, provided it is not marked as "special". */); - DEFVAR_PER_BUFFER ("minor-modes", &BVAR (current_buffer, minor_modes), + DEFVAR_PER_BUFFER ("local-minor-modes", + &BVAR (current_buffer, local_minor_modes), Qnil, doc: /* Minor modes currently active in the current buffer. This is a list of symbols, or nil if there are no minor modes active. */); diff --git a/src/buffer.h b/src/buffer.h index 0668d16608b..24e9c3fcbc8 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -339,7 +339,7 @@ struct buffer Lisp_Object major_mode_; /* Symbol listing all currently enabled minor modes. */ - Lisp_Object minor_modes_; + Lisp_Object local_minor_modes_; /* Pretty name of major mode (e.g., "Lisp"). */ Lisp_Object mode_name_; diff --git a/src/pdumper.c b/src/pdumper.c index b68f992c33a..337742fda4a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2692,7 +2692,7 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_732A01EB61 +#if CHECK_STRUCTS && !defined HASH_buffer_F8FE65D42F # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; @@ -2703,7 +2703,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) buffer->window_count = 0; else eassert (buffer->window_count == -1); - buffer->minor_modes_ = Qnil; + buffer->local_minor_modes_ = Qnil; buffer->last_selected_window_ = Qnil; buffer->display_count_ = make_fixnum (0); buffer->clip_changed = 0; From b535c8ba8735409b43ec9b1ce99a966cfa1383b1 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Feb 2021 13:08:15 +0100 Subject: [PATCH 215/297] Add a new variable `global-minor-modes' * doc/lispref/modes.texi (Minor Modes): Document it. * lisp/simple.el (global-minor-modes): New variable. (completion-in-mode-p): Use it. (completion-with-modes-p): Use it. * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Support it. --- doc/lispref/modes.texi | 5 +++++ etc/NEWS | 8 +++++++- lisp/emacs-lisp/easy-mmode.el | 13 ++++++++----- lisp/simple.el | 13 ++++++++++--- 4 files changed, 30 insertions(+), 9 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 192ffb6a0a9..e1299b52d41 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1466,6 +1466,11 @@ This buffer-local variable lists the currently enabled minor modes in the current buffer, and is a list of symbols. @end defvar +@defvar global-minor-modes +This variable lists the currently enabled global minor modes, and is a +list of symbols. +@end defvar + @defvar minor-mode-list The value of this variable is a list of all minor mode commands. @end defvar diff --git a/etc/NEWS b/etc/NEWS index eeaed3b5cfa..7f32f7bf6a9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2297,7 +2297,13 @@ that is not compatible with byte code in previous Emacs versions. +++ ** New buffer-local variable 'local-minor-modes'. This permanently buffer-local variable holds a list of currently -enabled minor modes in the current buffer (as a list of symbols). +enabled non-global minor modes in the current buffer (as a list of +symbols). + ++++ +** New variable 'global-minor-modes'. +This variable holds a list of currently enabled global minor modes (as +a list of symbols). +++ ** 'define-minor-mode' now takes an :interactive argument. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index c48ec505ce0..4a9e58083b0 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -330,11 +330,14 @@ or call the function `%s'.")))) nil) (t t))) - (unless ,globalp - ;; Keep `local-minor-modes' up to date. - (setq local-minor-modes (delq ',modefun local-minor-modes)) - (when ,getter - (push ',modefun local-minor-modes))) + ;; Keep minor modes list up to date. + ,@(if globalp + `((setq global-minor-modes (delq ',modefun global-minor-modes)) + (when ,getter + (push ',modefun global-minor-modes))) + `((setq local-minor-modes (delq ',modefun local-minor-modes)) + (when ,getter + (push ',modefun local-minor-modes)))) ,@body ;; The on/off hooks are here for backward compatibility only. (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) diff --git a/lisp/simple.el b/lisp/simple.el index cb7496d37c5..aafbb3e1f88 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -138,6 +138,10 @@ messages are highlighted; this helps to see what messages were visited." nil "Overlay highlighting the current error message in the `next-error' buffer.") +(defvar global-minor-modes nil + "A list of the currently enabled global minor modes. +This is a list of symbols.") + (defcustom next-error-hook nil "List of hook functions run by `next-error' after visiting source file." :type 'hook @@ -1985,14 +1989,16 @@ BUFFER, or any of the active minor modes in BUFFER." (or (provided-mode-derived-p (buffer-local-value 'major-mode buffer) (car modes)) (memq (car modes) - (buffer-local-value 'local-minor-modes buffer))) + (buffer-local-value 'local-minor-modes buffer)) + (memq (car modes) global-minor-modes)) ;; Uncommon case: Multiple modes. (apply #'provided-mode-derived-p (buffer-local-value 'major-mode buffer) modes) (seq-intersection modes (buffer-local-value 'local-minor-modes buffer) - #'eq))))) + #'eq) + (seq-intersection modes global-minor-modes #'eq))))) (defun completion-with-modes-p (modes buffer) "Say whether MODES are in action in BUFFER. @@ -2004,7 +2010,8 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER." ;; It's a minor mode. (seq-intersection modes (buffer-local-value 'local-minor-modes buffer) - #'eq))) + #'eq) + (seq-intersection modes global-minor-modes #'eq))) (defun completion-button-p (category buffer) "Return non-nil if there's a button of CATEGORY at point in BUFFER." From 398811b7f67e2a27d31541e5200707911a3377ce Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Feb 2021 13:43:27 +0100 Subject: [PATCH 216/297] Do `interactive' mode tagging in the remaining lisp/gnus files --- lisp/gnus/message.el | 138 ++++++++++++++++++++------------------- lisp/gnus/mml-sec.el | 42 ++++++------ lisp/gnus/mml.el | 2 +- lisp/gnus/nnagent.el | 1 + lisp/gnus/score-mode.el | 6 +- lisp/gnus/smiley.el | 2 +- lisp/gnus/smime.el | 2 +- lisp/gnus/spam-report.el | 6 +- lisp/gnus/spam-stat.el | 1 - lisp/gnus/spam.el | 11 ++-- 10 files changed, 109 insertions(+), 102 deletions(-) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 5a5dbcebc1e..ee98099e08b 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2334,7 +2334,8 @@ Leading \"Re: \" is not stripped by this function. Use the function "Ask for NEW-SUBJECT header, append (was: )." (interactive (list - (read-from-minibuffer "New subject: "))) + (read-from-minibuffer "New subject: ")) + message-mode) (cond ((and (not (or (null new-subject) ; new subject not empty (zerop (string-width new-subject)) (string-match "^[ \t]*$" new-subject)))) @@ -2364,7 +2365,7 @@ Leading \"Re: \" is not stripped by this function. Use the function "Mark some region in the current article with enclosing tags. See `message-mark-insert-begin' and `message-mark-insert-end'. If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." - (interactive "r\nP") + (interactive "r\nP" message-mode) (save-excursion ;; add to the end of the region first, otherwise end would be invalid (goto-char end) @@ -2376,7 +2377,7 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." "Insert FILE at point, marking it with enclosing tags. See `message-mark-insert-begin' and `message-mark-insert-end'. If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." - (interactive "fFile to insert: \nP") + (interactive "fFile to insert: \nP" message-mode) ;; reverse insertion to get correct result. (let ((p (point))) (insert (if verbatim "#v-\n" message-mark-insert-end)) @@ -2390,7 +2391,7 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." The note can be customized using `message-archive-note'. When called with a prefix argument, ask for a text to insert. If you don't want the note in the body, set `message-archive-note' to nil." - (interactive) + (interactive nil message-mode) (if current-prefix-arg (setq message-archive-note (read-from-minibuffer "Reason for No-Archive: " @@ -2416,7 +2417,8 @@ With prefix-argument just set Follow-Up, don't cross-post." gnus-newsrc-alist) nil nil '("poster" . 0) (if (boundp 'gnus-group-history) - 'gnus-group-history))))) + 'gnus-group-history)))) + message-mode) (message-remove-header "Follow[Uu]p-[Tt]o" t) (message-goto-newsgroups) (beginning-of-line) @@ -2493,7 +2495,8 @@ With prefix-argument just set Follow-Up, don't cross-post." gnus-newsrc-alist) nil nil '("poster" . 0) (if (boundp 'gnus-group-history) - 'gnus-group-history))))) + 'gnus-group-history)))) + message-mode) (when (fboundp 'gnus-group-real-name) (setq target-group (gnus-group-real-name target-group))) (cond ((not (or (null target-group) ; new subject not empty @@ -2528,7 +2531,7 @@ With prefix-argument just set Follow-Up, don't cross-post." (defun message-reduce-to-to-cc () "Replace contents of To: header with contents of Cc: or Bcc: header." - (interactive) + (interactive nil message-mode) (let ((cc-content (save-restriction (message-narrow-to-headers) (message-fetch-field "cc"))) @@ -2694,7 +2697,7 @@ Point is left at the beginning of the narrowed-to region." (defun message-sort-headers () "Sort headers of the current message according to `message-header-format-alist'." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (let ((max (1+ (length message-header-format-alist))) @@ -2715,7 +2718,7 @@ Point is left at the beginning of the narrowed-to region." (defun message-kill-address () "Kill the address under point." - (interactive) + (interactive nil message-mode) (let ((start (point))) (message-skip-to-next-address) (kill-region start (if (bolp) (1- (point)) (point))))) @@ -3208,79 +3211,79 @@ Like `text-mode', but with these additional commands: (defun message-goto-to () "Move point to the To header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "To")) (defun message-goto-from () "Move point to the From header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "From")) (defun message-goto-subject () "Move point to the Subject header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Subject")) (defun message-goto-cc () "Move point to the Cc header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Cc" "To")) (defun message-goto-bcc () "Move point to the Bcc header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Bcc" "Cc" "To")) (defun message-goto-fcc () "Move point to the Fcc header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Fcc" "To" "Newsgroups")) (defun message-goto-reply-to () "Move point to the Reply-To header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Reply-To" "Subject")) (defun message-goto-newsgroups () "Move point to the Newsgroups header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Newsgroups")) (defun message-goto-distribution () "Move point to the Distribution header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Distribution")) (defun message-goto-followup-to () "Move point to the Followup-To header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Followup-To" "Newsgroups")) (defun message-goto-mail-followup-to () "Move point to the Mail-Followup-To header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Mail-Followup-To" "To")) (defun message-goto-keywords () "Move point to the Keywords header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Keywords" "Subject")) (defun message-goto-summary () "Move point to the Summary header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Summary" "Subject")) @@ -3288,7 +3291,7 @@ Like `text-mode', but with these additional commands: (defun message-goto-body (&optional interactive) "Move point to the beginning of the message body. Returns point." - (interactive "p") + (interactive "p" message-mode) (when interactive (when (looking-at "[ \t]*\n") (expand-abbrev)) @@ -3315,7 +3318,7 @@ Returns point." (defun message-goto-eoh (&optional interactive) "Move point to the end of the headers." - (interactive "p") + (interactive "p" message-mode) (message-goto-body interactive) (forward-line -1)) @@ -3323,7 +3326,7 @@ Returns point." "Move point to the beginning of the message signature. If there is no signature in the article, go to the end and return nil." - (interactive) + (interactive nil message-mode) (push-mark) (goto-char (point-min)) (if (re-search-forward message-signature-separator nil t) @@ -3342,7 +3345,7 @@ in the current mail buffer, and appends the current `user-mail-address'. If the optional argument INCLUDE-CC is non-nil, the addresses in the Cc: header are also put into the MFT." - (interactive "P") + (interactive "P" message-mode) (let* (cc tos) (save-restriction (message-narrow-to-headers) @@ -3360,7 +3363,7 @@ Cc: header are also put into the MFT." "Insert a To header that points to the author of the article being replied to. If the original author requested not to be sent mail, don't insert unless the prefix FORCE is given." - (interactive "P") + (interactive "P" message-mode) (let* ((mct (message-fetch-reply-field "mail-copies-to")) (dont (and mct (or (equal (downcase mct) "never") (equal (downcase mct) "nobody")))) @@ -3379,7 +3382,7 @@ prefix FORCE is given." (defun message-insert-wide-reply () "Insert To and Cc headers as if you were doing a wide reply." - (interactive) + (interactive nil message-mode) (let ((headers (message-with-reply-buffer (message-get-reply-headers t)))) (message-carefully-insert-headers headers))) @@ -3424,7 +3427,7 @@ or in the synonym headers, defined by `message-header-synonyms'." (defun message-widen-reply () "Widen the reply to include maximum recipients." - (interactive) + (interactive nil message-mode) (let ((follow-to (and (buffer-live-p message-reply-buffer) (with-current-buffer message-reply-buffer @@ -3440,7 +3443,7 @@ or in the synonym headers, defined by `message-header-synonyms'." (defun message-insert-newsgroups () "Insert the Newsgroups header from the article being replied to." - (interactive) + (interactive nil message-mode) (let ((old-newsgroups (mail-fetch-field "newsgroups")) (new-newsgroups (message-fetch-reply-field "newsgroups")) (first t) @@ -3475,13 +3478,13 @@ or in the synonym headers, defined by `message-header-synonyms'." (defun message-widen-and-recenter () "Widen the buffer and go to the start." - (interactive) + (interactive nil message-mode) (widen) (goto-char (point-min))) (defun message-delete-not-region (beg end) "Delete everything in the body of the current message outside of the region." - (interactive "r") + (interactive "r" message-mode) (let (citeprefix) (save-excursion (goto-char beg) @@ -3508,7 +3511,7 @@ or in the synonym headers, defined by `message-header-synonyms'." "Kill all text up to the signature. If a numeric argument or prefix arg is given, leave that number of lines before the signature intact." - (interactive "P") + (interactive "P" message-mode) (save-excursion (save-restriction (let ((point (point))) @@ -3526,7 +3529,7 @@ of lines before the signature intact." (defun message-newline-and-reformat (&optional arg not-break) "Insert four newlines, and then reformat if inside quoted text. Prefix arg means justify as well." - (interactive (list (if current-prefix-arg 'full))) + (interactive (list (if current-prefix-arg 'full)) message-mode) (unless (message-in-body-p) (error "This command only works in the body of the message")) (let (quoted point beg end leading-space bolp fill-paragraph-function) @@ -3617,7 +3620,7 @@ Prefix arg means justify as well." "Message specific function to fill a paragraph. This function is used as the value of `fill-paragraph-function' in Message buffers and is not meant to be called directly." - (interactive (list (if current-prefix-arg 'full))) + (interactive (list (if current-prefix-arg 'full)) message-mode) (if (message-point-in-header-p) (message-fill-field) (message-newline-and-reformat arg t)) @@ -3648,7 +3651,7 @@ more information. If FORCE is 0 (or when called interactively), the global values of the signature variables will be consulted if the local ones are null." - (interactive (list 0)) + (interactive (list 0) message-mode) (let ((message-signature message-signature) (message-signature-file message-signature-file)) ;; If called interactively and there's no signature to insert, @@ -3707,7 +3710,7 @@ are null." (defun message-insert-importance-high () "Insert header to mark message as important." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (message-narrow-to-headers) @@ -3717,7 +3720,7 @@ are null." (defun message-insert-importance-low () "Insert header to mark message as unimportant." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (message-narrow-to-headers) @@ -3729,7 +3732,7 @@ are null." "Insert a \"Importance: high\" header, or cycle through the header values. The three allowed values according to RFC 1327 are `high', `normal' and `low'." - (interactive) + (interactive nil message-mode) (save-excursion (let ((new "high") cur) @@ -3749,7 +3752,7 @@ and `low'." (defun message-insert-disposition-notification-to () "Request a disposition notification (return receipt) to this message. Note that this should not be used in newsgroups." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (message-narrow-to-headers) @@ -3764,7 +3767,7 @@ Note that this should not be used in newsgroups." "Elide the text in the region. An ellipsis (from `message-elide-ellipsis') will be inserted where the text was killed." - (interactive "r") + (interactive "r" message-mode) (let ((lines (count-lines b e)) (chars (- e b))) (kill-region b e) @@ -3781,7 +3784,8 @@ text was killed." (min (point) (or (mark t) (point))) (max (point) (or (mark t) (point))) (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) + (prefix-numeric-value current-prefix-arg))) + message-mode) (setq n (if (numberp n) (mod n 26) 13)) ;canonize N (unless (or (zerop n) ; no action needed for a rot of 0 @@ -3815,7 +3819,8 @@ With prefix arg, specifies the number of places to rotate each letter forward. Mail and USENET news headers are not rotated unless WIDE is non-nil." (interactive (if current-prefix-arg (list (prefix-numeric-value current-prefix-arg)) - (list nil))) + (list nil)) + message-mode) (save-excursion (save-restriction (when (and (not wide) (message-goto-body)) @@ -3835,7 +3840,7 @@ Mail and USENET news headers are not rotated unless WIDE is non-nil." "Rename the *message* buffer to \"*message* RECIPIENT\". If the function is run with a prefix, it will ask for a new buffer name, rather than giving an automatic name." - (interactive "Pbuffer name: ") + (interactive "Pbuffer name: " message-mode) (save-excursion (save-restriction (goto-char (point-min)) @@ -3858,7 +3863,7 @@ name, rather than giving an automatic name." (defun message-fill-yanked-message (&optional justifyp) "Fill the paragraphs of a message yanked into this one. Numeric argument means justify as well." - (interactive "P") + (interactive "P" message-mode) (save-excursion (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n") nil t) @@ -3923,7 +3928,7 @@ If REMOVE is non-nil, remove newlines, too. To use this automatically, you may add this function to `gnus-message-setup-hook'." - (interactive "P") + (interactive "P" message-mode) (let ((citexp (concat "^\\(" (concat message-yank-cited-prefix "\\|") message-yank-prefix @@ -3988,7 +3993,7 @@ This function uses `message-cite-function' to do the actual citing. Just \\[universal-argument] as argument means don't indent, insert no prefix, and don't delete any headers." - (interactive "P") + (interactive "P" message-mode) ;; eval the let forms contained in message-cite-style (let ((bindings (if (symbolp message-cite-style) (symbol-value message-cite-style) @@ -3999,7 +4004,7 @@ prefix, and don't delete any headers." (defun message-yank-buffer (buffer) "Insert BUFFER into the current buffer and quote it." - (interactive "bYank buffer: ") + (interactive "bYank buffer: " message-mode) (let ((message-reply-buffer (get-buffer buffer))) (save-window-excursion (message-yank-original)))) @@ -4226,7 +4231,7 @@ This function strips off the signature from the original message." "Send message like `message-send', then, if no errors, exit from mail buffer. The usage of ARG is defined by the instance that called Message. It should typically alter the sending method in some way or other." - (interactive "P") + (interactive "P" message-mode) (let ((buf (current-buffer)) (position (point-marker)) (actions message-exit-actions)) @@ -4246,7 +4251,7 @@ It should typically alter the sending method in some way or other." (defun message-dont-send () "Don't send the message you have been editing. Instead, just auto-save the buffer and then bury it." - (interactive) + (interactive nil message-mode) (set-buffer-modified-p t) (save-buffer) (let ((actions message-postpone-actions)) @@ -4255,7 +4260,7 @@ Instead, just auto-save the buffer and then bury it." (defun message-kill-buffer () "Kill the current buffer." - (interactive) + (interactive nil message-mode) (when (or (not (buffer-modified-p)) (not message-kill-buffer-query) (yes-or-no-p "Message modified; kill anyway? ")) @@ -4304,7 +4309,7 @@ Otherwise any failure is reported in a message back to the user from the mailer. The usage of ARG is defined by the instance that called Message. It should typically alter the sending method in some way or other." - (interactive "P") + (interactive "P" message-mode) ;; Make it possible to undo the coming changes. (undo-boundary) (let ((inhibit-read-only t)) @@ -4572,7 +4577,7 @@ An address might be bogus if there's a matching entry in "Warn before composing or sending a mail to an invalid address. This function could be useful in `message-setup-hook'." - (interactive) + (interactive nil message-mode) (save-restriction (message-narrow-to-headers) (dolist (hdr '("To" "Cc" "Bcc")) @@ -5744,7 +5749,7 @@ If NOW, use that time instead." (defun message-insert-expires (days) "Insert the Expires header. Expiry in DAYS days." - (interactive "NExpire article in how many days? ") + (interactive "NExpire article in how many days? " message-mode) (save-excursion (message-position-on-field "Expires" "X-Draft-From") (insert (message-make-expires-date days)))) @@ -6047,7 +6052,7 @@ give as trustworthy answer as possible." (defun message-to-list-only () "Send a message to the list only. Remove all addresses but the list address from To and Cc headers." - (interactive) + (interactive nil message-mode) (let ((listaddr (message-make-mail-followup-to t))) (when listaddr (save-excursion @@ -6133,7 +6138,7 @@ subscribed address (and not the additional To and Cc header contents)." (defun message-idna-to-ascii-rhs () "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. See `message-idna-encode'." - (interactive) + (interactive nil message-mode) (when message-use-idna (save-excursion (save-restriction @@ -6351,7 +6356,7 @@ Headers already prepared in the buffer are not modified." (defun message-split-line () "Split current line, moving portion beyond point vertically down. If the current line has `message-yank-prefix', insert it on the new line." - (interactive "*") + (interactive "*" message-mode) (split-line message-yank-prefix)) (defun message-insert-header (header value) @@ -6549,7 +6554,7 @@ When called without a prefix argument, header value spanning multiple lines is treated as a single line. Otherwise, even if N is 1, when point is on a continuation header line, it will be moved to the beginning " - (interactive "^p") + (interactive "^p" message-mode) (cond ;; Go to beginning of header or beginning of line. ((and message-beginning-of-line (message-point-in-header-p)) @@ -6874,7 +6879,7 @@ are not included." (defun message-insert-headers () "Generate the headers for the article." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (message-narrow-to-headers) @@ -8214,7 +8219,7 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed." Execute function specified by `message-tab-body-function' when not in those headers. If that variable is nil, indent with the regular text mode tabbing command." - (interactive) + (interactive nil message-mode) (cond ((let ((completion-fail-discreetly t)) (completion-at-point)) @@ -8591,7 +8596,7 @@ From headers in the original article." (defun message-display-abbrev (&optional choose) "Display the next possible abbrev for the text before point." - (interactive (list t)) + (interactive (list t) message-mode) (when (message--in-tocc-p) (let* ((end (point)) (start (save-excursion @@ -8678,7 +8683,7 @@ Unless FORCE, prompt before sending. The messages are separated by `message-form-letter-separator'. Header and body are separated by `mail-header-separator'." - (interactive "P") + (interactive "P" message-mode) (let ((sent 0) (skipped 0) start end text buff @@ -8746,7 +8751,7 @@ Used in `message-simplify-recipients'." (make-obsolete 'message-simplify-recipients nil "27.1") (defun message-simplify-recipients () - (interactive) + (interactive nil message-mode) (dolist (hdr '("Cc" "To")) (message-replace-header hdr @@ -8769,7 +8774,8 @@ Used in `message-simplify-recipients'." (defun message-make-html-message-with-image-files (files) "Make a message containing the current dired-marked image files." - (interactive (list (dired-get-marked-files nil current-prefix-arg))) + (interactive (list (dired-get-marked-files nil current-prefix-arg)) + dired-mode) (message-mail) (message-goto-body) (insert "<#part type=text/html>\n\n") @@ -8780,7 +8786,7 @@ Used in `message-simplify-recipients'." (defun message-toggle-image-thumbnails () "For any included image files, insert a thumbnail of that image." - (interactive) + (interactive nil message-mode) (let ((displayed nil)) (save-excursion (goto-char (point-min)) @@ -8816,7 +8822,7 @@ starting the screenshotting process. The `message-screenshot-command' variable says what command is used to take the screenshot." - (interactive "p") + (interactive "p" message-mode) (unless (executable-find (car message-screenshot-command)) (error "Can't find %s to take the screenshot" (car message-screenshot-command))) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index d41c9dd0d9a..a32eed44196 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -250,7 +250,7 @@ You can also customize or set `mml-signencrypt-style-alist' instead." "Add MML tags to sign this MML part. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-part (or method mml-secure-method mml-default-sign-method) 'sign)) @@ -259,43 +259,43 @@ Use METHOD if given. Else use `mml-secure-method' or "Add MML tags to encrypt this MML part. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-part (or method mml-secure-method mml-default-sign-method))) (defun mml-secure-sign-pgp () "Add MML tags to PGP sign this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgp" 'sign)) (defun mml-secure-sign-pgpauto () "Add MML tags to PGP-auto sign this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgpauto" 'sign)) (defun mml-secure-sign-pgpmime () "Add MML tags to PGP/MIME sign this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgpmime" 'sign)) (defun mml-secure-sign-smime () "Add MML tags to S/MIME sign this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "smime" 'sign)) (defun mml-secure-encrypt-pgp () "Add MML tags to PGP encrypt this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgp")) (defun mml-secure-encrypt-pgpmime () "Add MML tags to PGP/MIME encrypt this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgpmime")) (defun mml-secure-encrypt-smime () "Add MML tags to S/MIME encrypt this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "smime")) (defun mml-secure-is-encrypted-p (&optional tag-present) @@ -358,7 +358,7 @@ either an error is raised or not." (defun mml-unsecure-message () "Remove security related MML tags from message." - (interactive) + (interactive nil mml-mode) (save-excursion (goto-char (point-max)) (when (re-search-backward "^<#secure.*>\n" nil t) @@ -369,7 +369,7 @@ either an error is raised or not." "Add MML tags to sign the entire message. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-message (or method mml-secure-method mml-default-sign-method) 'sign)) @@ -378,7 +378,7 @@ Use METHOD if given. Else use `mml-secure-method' or "Add MML tag to sign and encrypt the entire message. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-message (or method mml-secure-method mml-default-sign-method) 'signencrypt)) @@ -387,53 +387,53 @@ Use METHOD if given. Else use `mml-secure-method' or "Add MML tag to encrypt the entire message. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-message (or method mml-secure-method mml-default-sign-method) 'encrypt)) (defun mml-secure-message-sign-smime () "Add MML tag to encrypt/sign the entire message." - (interactive) + (interactive nil mml-mode) (mml-secure-message "smime" 'sign)) (defun mml-secure-message-sign-pgp () "Add MML tag to encrypt/sign the entire message." - (interactive) + (interactive nil mml-mode) (mml-secure-message "pgp" 'sign)) (defun mml-secure-message-sign-pgpmime () "Add MML tag to encrypt/sign the entire message." - (interactive) + (interactive nil mml-mode) (mml-secure-message "pgpmime" 'sign)) (defun mml-secure-message-sign-pgpauto () "Add MML tag to encrypt/sign the entire message." - (interactive) + (interactive nil mml-mode) (mml-secure-message "pgpauto" 'sign)) (defun mml-secure-message-encrypt-smime (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") + (interactive "P" mml-mode) (mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt))) (defun mml-secure-message-encrypt-pgp (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") + (interactive "P" mml-mode) (mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt))) (defun mml-secure-message-encrypt-pgpmime (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") + (interactive "P" mml-mode) (mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt))) (defun mml-secure-message-encrypt-pgpauto (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") + (interactive "P" mml-mode) (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt))) ;;; Common functionality for mml1991.el, mml2015.el, mml-smime.el diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index f77e5c6434e..dcc9ea51dd2 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1339,7 +1339,7 @@ If not set, `default-directory' will be used." (defun mml-quote-region (beg end) "Quote the MML tags in the region." - (interactive "r") + (interactive "r" mml-mode) (save-excursion (save-restriction ;; Temporarily narrow the region to defend from changes diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 76a7e21567a..56ca2e14b6f 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -1,3 +1,4 @@ + ;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el index d3ed3600ad9..51408618904 100644 --- a/lisp/gnus/score-mode.el +++ b/lisp/gnus/score-mode.el @@ -83,12 +83,12 @@ This mode is an extended emacs-lisp mode. (defun gnus-score-edit-insert-date () "Insert date in numerical format." - (interactive) + (interactive nil gnus-score-mode) (princ (time-to-days nil) (current-buffer))) (defun gnus-score-pretty-print () "Format the current score file." - (interactive) + (interactive nil gnus-score-mode) (goto-char (point-min)) (let ((form (read (current-buffer)))) (erase-buffer) @@ -98,7 +98,7 @@ This mode is an extended emacs-lisp mode. (defun gnus-score-edit-exit () "Stop editing the score file." - (interactive) + (interactive nil gnus-score-mode) (unless (file-exists-p (file-name-directory (buffer-file-name))) (make-directory (file-name-directory (buffer-file-name)) t)) (let ((coding-system-for-write score-mode-coding-system)) diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index 3ee59479cf5..32283af52bf 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -242,7 +242,7 @@ interactively. If there's no argument, do it at the current buffer." (defun smiley-toggle-buffer (&optional arg) "Toggle displaying smiley faces in article buffer. With arg, turn displaying on if and only if arg is positive." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (if (if (numberp arg) (> arg 0) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 8900be5e4f1..2446577c6ad 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -672,7 +672,7 @@ The following commands are available: (defun smime-exit () "Quit the S/MIME buffer." - (interactive) + (interactive nil smime-mode) (kill-buffer (current-buffer))) ;; Other functions diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index d87a6c2af0d..7d93f8a5550 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -120,7 +120,8 @@ submitted at once. Internal variable.") (defun spam-report-gmane-ham (&rest articles) "Report ARTICLES as ham (unregister) through Gmane." - (interactive (gnus-summary-work-articles current-prefix-arg)) + (interactive (gnus-summary-work-articles current-prefix-arg) + gnus-summary-mode) (let ((count 0)) (dolist (article articles) (setq count (1+ count)) @@ -130,7 +131,8 @@ submitted at once. Internal variable.") (defun spam-report-gmane-spam (&rest articles) "Report ARTICLES as spam through Gmane." - (interactive (gnus-summary-work-articles current-prefix-arg)) + (interactive (gnus-summary-work-articles current-prefix-arg) + gnus-summary-mode) (let ((count 0)) (dolist (article articles) (setq count (1+ count)) diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 70753cad9ca..3e804ecb4bb 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -575,7 +575,6 @@ check the variable `spam-stat-score-data'." (defun spam-stat-count () "Return size of `spam-stat'." - (interactive) (hash-table-count spam-stat)) (defun spam-stat-test-directory (dir &optional verbose) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index f7288c98f6f..d00f0a60b66 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -1604,7 +1604,6 @@ parameters. A string as a parameter will set the `spam-split-group' to that string. See the Info node `(gnus)Fancy Mail Splitting' for more details." - (interactive) (setq spam-split-last-successful-check nil) (unless spam-split-disabled (let ((spam-split-group-choice spam-split-group)) @@ -1654,7 +1653,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun spam-find-spam () "Detect spam in the current newsgroup using `spam-split'." - (interactive) + (interactive nil gnus-summary-mode) (let* ((group gnus-newsgroup-name) (autodetect (gnus-parameter-spam-autodetect group)) @@ -2434,7 +2433,7 @@ With a non-nil REMOVE, remove the ADDRESSES." ;; return something sensible if the score can't be determined (defun spam-bogofilter-score (&optional recheck) "Get the Bogofilter spamicity score." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) @@ -2606,7 +2605,7 @@ With a non-nil REMOVE, remove the ADDRESSES." ;; return something sensible if the score can't be determined (defun spam-spamassassin-score (&optional recheck) "Get the SpamAssassin score." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) @@ -2673,7 +2672,7 @@ With a non-nil REMOVE, remove the ADDRESSES." ;; return something sensible if the score can't be determined (defun spam-bsfilter-score (&optional recheck) "Get the Bsfilter spamicity score." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) @@ -2759,7 +2758,7 @@ With a non-nil REMOVE, remove the ADDRESSES." ;; return something sensible if the score can't be determined (defun spam-crm114-score () "Get the CRM114 Mailfilter pR." - (interactive) + (interactive nil gnus-summary-mode) (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) From 6ea920c88d7705e7b09571819d3948efd2e53109 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Feb 2021 14:43:53 +0100 Subject: [PATCH 217/297] Allow overriding declared predicates, too * lisp/simple.el (completion-default-include-p): Rename and move the checking for an explicit predicate down here... (read-extended-command): ... from here. (read-extended-command-predicate): Adjust default value. --- lisp/simple.el | 60 ++++++++++++++++++++++++++------------------------ 1 file changed, 31 insertions(+), 29 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index aafbb3e1f88..8a9f46cef6c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1904,15 +1904,15 @@ to get different commands to edit and resubmit." (defvar extended-command-history nil) (defvar execute-extended-command--last-typed nil) -(defcustom read-extended-command-predicate #'completion-in-mode-p +(defcustom read-extended-command-predicate #'completion-default-include-p "Predicate to use to determine which commands to include when completing. The predicate function is called with two parameter: The symbol (i.e., command) in question that should be included or not, and the current buffer. The predicate should return non-nil if the command should be present when doing `M-x TAB'." :version "28.1" - :type '(choice (const :tag "Exclude commands not relevant to this mode" - #'completion-in-mode-p) + :type '(choice (const :tag "Exclude commands not relevant to the current mode" + #'completion-default-include-p) (const :tag "All commands" (lambda (_ _) t)) (function :tag "Other function"))) @@ -1970,35 +1970,37 @@ This function uses the `read-extended-command-predicate' user option." (complete-with-action action obarray string pred))) (lambda (sym) (and (commandp sym) - ;;; FIXME: This should also be possible to disable by - ;;; the user, but I'm not quite sure what the right - ;;; design for that would look like. - (if (get sym 'completion-predicate) - (funcall (get sym 'completion-predicate) sym buffer) - (funcall read-extended-command-predicate sym buffer)))) + (funcall read-extended-command-predicate sym buffer))) t nil 'extended-command-history)))) -(defun completion-in-mode-p (symbol buffer) +(defun completion-default-include-p (symbol buffer) "Say whether SYMBOL should be offered as a completion. -This is true if the command is applicable to the major mode in -BUFFER, or any of the active minor modes in BUFFER." - (let ((modes (command-modes symbol))) - (or (null modes) - ;; Common case: Just a single mode. - (if (null (cdr modes)) - (or (provided-mode-derived-p - (buffer-local-value 'major-mode buffer) (car modes)) - (memq (car modes) - (buffer-local-value 'local-minor-modes buffer)) - (memq (car modes) global-minor-modes)) - ;; Uncommon case: Multiple modes. - (apply #'provided-mode-derived-p - (buffer-local-value 'major-mode buffer) - modes) - (seq-intersection modes - (buffer-local-value 'local-minor-modes buffer) - #'eq) - (seq-intersection modes global-minor-modes #'eq))))) +If there's a `completion-predicate' for SYMBOL, the result from +calling that predicate is called. If there isn't one, this +predicate is true if the command SYMBOL is applicable to the +major mode in BUFFER, or any of the active minor modes in +BUFFER." + (if (get symbol 'completion-predicate) + ;; An explicit completion predicate takes precedence. + (funcall (get symbol 'completion-predicate) symbol buffer) + ;; Check the modes. + (let ((modes (command-modes symbol))) + (or (null modes) + ;; Common case: Just a single mode. + (if (null (cdr modes)) + (or (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) (car modes)) + (memq (car modes) + (buffer-local-value 'local-minor-modes buffer)) + (memq (car modes) global-minor-modes)) + ;; Uncommon case: Multiple modes. + (apply #'provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + modes) + (seq-intersection modes + (buffer-local-value 'local-minor-modes buffer) + #'eq) + (seq-intersection modes global-minor-modes #'eq)))))) (defun completion-with-modes-p (modes buffer) "Say whether MODES are in action in BUFFER. From fc4927fc3a27e995337612dde8614f0309616dde Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Feb 2021 10:50:07 -0500 Subject: [PATCH 218/297] * lisp/emacs-lisp/bindat.el: Expose the `struct` variable (bug#46534) (bindat--unpack-group, bindat--length-group, bindat--pack-group): Mark it as dynamically scoped. --- lisp/emacs-lisp/bindat.el | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 0d9ba57d663..bf01347ae0e 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -26,7 +26,7 @@ ;; Packing and unpacking of (binary) data structures. ;; ;; The data formats used in binary files and network protocols are -;; often structed data which can be described by a C-style structure +;; often structured data which can be described by a C-style structure ;; such as the one shown below. Using the bindat package, decoding ;; and encoding binary data formats like these is made simple using a ;; structure specification which closely resembles the C style @@ -135,7 +135,8 @@ ;; | ( [FIELD] repeat COUNT ITEM... ) ;; -- In (eval EXPR), the value of the last field is available in -;; the dynamically bound variable `last'. +;; the dynamically bound variable `last' and all the previous +;; ones in the variable `struct'. ;; TYPE ::= ( eval EXPR ) -- interpret result as TYPE ;; | u8 | byte -- length 1 @@ -191,7 +192,7 @@ ;;; Code: ;; Helper functions for structure unpacking. -;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX +;; Relies on dynamic binding of `bindat-raw' and `bindat-idx'. (defvar bindat-raw) (defvar bindat-idx) @@ -276,8 +277,8 @@ (t nil))) (defun bindat--unpack-group (spec) - (with-suppressed-warnings ((lexical last)) - (defvar last)) + (with-suppressed-warnings ((lexical struct last)) + (defvar struct) (defvar last)) (let (struct last) (while spec (let* ((item (car spec)) @@ -378,9 +379,9 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (ip . 4))) (defun bindat--length-group (struct spec) - (with-suppressed-warnings ((lexical last)) - (defvar last)) - (let (last) + (with-suppressed-warnings ((lexical struct last)) + (defvar struct) (defvar last)) + (let ((struct struct) last) (while spec (let* ((item (car spec)) (field (car item)) @@ -544,9 +545,9 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq bindat-idx (+ bindat-idx len))))) (defun bindat--pack-group (struct spec) - (with-suppressed-warnings ((lexical last)) - (defvar last)) - (let (last) + (with-suppressed-warnings ((lexical struct last)) + (defvar struct) (defvar last)) + (let ((struct struct) last) (while spec (let* ((item (car spec)) (field (car item)) From 211731b3a94bf1380e4fb08d9f6ed65e9ed98b22 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Feb 2021 10:57:26 -0500 Subject: [PATCH 219/297] * lisp/calc/calc-sel.el (calc-replace-sub-formula): Fix typo MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reported by Sébastien Miquel --- lisp/calc/calc-sel.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index 2b317ac3696..18fd483bafe 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -486,8 +486,8 @@ (defun calc-replace-sub-formula (expr rsf-old rsf-new) (let ((calc-rsf-old rsf-old) - (calc-rsf-new (calc-encase-atoms rsf-new)))) - (calc-replace-sub-formula-rec expr)) + (calc-rsf-new (calc-encase-atoms rsf-new))) + (calc-replace-sub-formula-rec expr))) (defun calc-replace-sub-formula-rec (expr) (cond ((eq expr calc-rsf-old) calc-rsf-new) From 899619ff6a73cc75880327ad74ec29f072328d79 Mon Sep 17 00:00:00 2001 From: Ulf Jasper Date: Mon, 15 Feb 2021 17:27:45 +0100 Subject: [PATCH 220/297] Display yearly ical events from first year on. Fix Bug#23100. Convert yearly rrule starting in year x into diary-anniversary entry for year x-1 when importing an icalendar. Correspondingly convert diary-anniversary for year x into yearly rrule starting in year x+1. * test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american: * test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european: * test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso: * test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american: * test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european: * test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso: * test/lisp/calendar/icalendar-tests.el (icalendar-convert-anniversary-to-ical): Match new diary-anniversary/yearly-rrule behaviour. * lisp/calendar/icalendar.el (icalendar--datestring-to-isodate): Add year-shift option. (icalendar--convert-anniversary-to-ical): Shift the year as diary-anniversary is not displayed in the initial year. (icalendar--convert-recurring-to-diary): Shift the year as diary-anniversary is not displayed in the initial year. (Bug#23100) --- lisp/calendar/icalendar.el | 26 ++-- .../import-rrule-anniversary.diary-american | 2 +- .../import-rrule-anniversary.diary-european | 2 +- .../import-rrule-anniversary.diary-iso | 2 +- .../import-rrule-yearly.diary-american | 2 +- .../import-rrule-yearly.diary-european | 2 +- .../import-rrule-yearly.diary-iso | 2 +- test/lisp/calendar/icalendar-tests.el | 112 ++++++++++-------- 8 files changed, 85 insertions(+), 65 deletions(-) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 1d7de4a0c5d..dafdd418d0d 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -889,12 +889,14 @@ If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days." (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))) -(defun icalendar--datestring-to-isodate (datestring &optional day-shift) +(defun icalendar--datestring-to-isodate (datestring &optional day-shift year-shift) "Convert diary-style DATESTRING to iso-style date. If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days --- DAY-SHIFT must be either nil or an integer. This function -tries to figure the date style from DATESTRING itself. If that -is not possible it uses the current calendar date style." +-- DAY-SHIFT must be either nil or an integer. If YEAR-SHIFT is +non-nil, the result is shifted by YEAR-SHIFT years -- YEAR-SHIFT +must be either nil or an integer. This function tries to figure +the date style from DATESTRING itself. If that is not possible +it uses the current calendar date style." (let ((day -1) month year) (save-match-data (cond ( ;; iso-style numeric date @@ -904,7 +906,7 @@ is not possible it uses the current calendar date style." "0?\\([1-9][0-9]?\\)") datestring) (setq year (read (substring datestring (match-beginning 1) - (match-end 1)))) + (match-end 1)))) (setq month (read (substring datestring (match-beginning 2) (match-end 2)))) (setq day (read (substring datestring (match-beginning 3) @@ -967,6 +969,9 @@ is not possible it uses the current calendar date style." (match-end 3))))) (t nil))) + (when year-shift + (setq year (+ year year-shift))) + (if (> day 0) (let ((mdy (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian (list month day @@ -1916,9 +1921,9 @@ entries. ENTRY-MAIN is the first line of the diary entry." (let* ((datetime (substring entry-main (match-beginning 1) (match-end 1))) (startisostring (icalendar--datestring-to-isodate - datetime)) + datetime nil 1)) (endisostring (icalendar--datestring-to-isodate - datetime 1)) + datetime 1 1)) (starttimestring (icalendar--diarytime-to-isotime (if (match-beginning 3) (substring entry-main @@ -2402,8 +2407,11 @@ END-T is the event's end time in diary format." (if end-t "-" "") (or end-t "")))) (setq result (format - "%%%%(and (diary-anniversary %s)) %s%s%s" - dtstart-conv + "%%%%(diary-anniversary %s) %s%s%s" + (let* ((year (nth 5 dtstart-dec)) + (dtstart-1y-dec (copy-sequence dtstart-dec))) + (setf (nth 5 dtstart-1y-dec) (1- year)) + (icalendar--datetime-to-diary-date dtstart-1y-dec)) (or start-t "") (if end-t "-" "") (or end-t ""))))) ;; monthly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american index 7b86b554dd4..2f7026a0bde 100644 --- a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american +++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american @@ -1 +1 @@ -&%%(and (diary-anniversary 8 15 2004)) Maria Himmelfahrt +&%%(diary-anniversary 8 15 2003) Maria Himmelfahrt diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european index 3b82ec09fd5..fa652dbb92e 100644 --- a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european +++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european @@ -1 +1 @@ -&%%(and (diary-anniversary 15 8 2004)) Maria Himmelfahrt +&%%(diary-anniversary 15 8 2003) Maria Himmelfahrt diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso index 7fc99478d4e..803dd36de0a 100644 --- a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso +++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso @@ -1 +1 @@ -&%%(and (diary-anniversary 2004 8 15)) Maria Himmelfahrt +&%%(diary-anniversary 2003 8 15) Maria Himmelfahrt diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american index a54780b9699..bc485d8a6c4 100644 --- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american +++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american @@ -1 +1 @@ -&%%(and (diary-anniversary 9 19 2003)) 09:00-11:30 rrule yearly +&%%(diary-anniversary 9 19 2002) 09:00-11:30 rrule yearly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european index a4bd81d6f2b..42509d42bc8 100644 --- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european +++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european @@ -1 +1 @@ -&%%(and (diary-anniversary 19 9 2003)) 09:00-11:30 rrule yearly +&%%(diary-anniversary 19 9 2002) 09:00-11:30 rrule yearly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso index 65a7abe0344..72fe6e12cbd 100644 --- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso +++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso @@ -1 +1 @@ -&%%(and (diary-anniversary 2003 9 19)) 09:00-11:30 rrule yearly +&%%(diary-anniversary 2002 9 19) 09:00-11:30 rrule yearly diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 7993a1fd806..61d3c11f6df 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -87,7 +87,7 @@ (let* ((calendar-date-style 'iso) result) (setq result (icalendar--convert-anniversary-to-ical - "" "%%(diary-anniversary 1964 6 30) g")) + "" "%%(diary-anniversary 1963 6 30) g")) (should (consp result)) (should (string= (concat "\nDTSTART;VALUE=DATE:19640630" @@ -353,7 +353,7 @@ END:VTIMEZONE (let ((calendar-date-style 'iso)) ;; numeric iso (should (string= "20080511" - (icalendar--datestring-to-isodate "2008 05 11"))) + (icalendar--datestring-to-isodate "2008 05 11"))) (should (string= "20080531" (icalendar--datestring-to-isodate "2008 05 31"))) (should (string= "20080602" @@ -384,7 +384,19 @@ END:VTIMEZONE (should (string= "20081105" (icalendar--datestring-to-isodate "05 Nov 2008"))) (should (string= "20081105" - (icalendar--datestring-to-isodate "2008 Nov 05"))))) + (icalendar--datestring-to-isodate "2008 Nov 05"))) + + ;; non-numeric with day-shift and year-shift + (setq calendar-date-style nil) ;not necessary for conversion + (should (string= "20210212" + (icalendar--datestring-to-isodate "2021 Feb 11" 1))) + (should (string= "20210131" + (icalendar--datestring-to-isodate "2021 Feb 11" -11))) + (should (string= "20200211" + (icalendar--datestring-to-isodate "2021 Feb 11" nil -1))) + (should (string= "21010211" + (icalendar--datestring-to-isodate "2021 Feb 11" nil 80))) + )) (ert-deftest icalendar--first-weekday-of-year () "Test method for `icalendar-first-weekday-of-year'." @@ -569,10 +581,10 @@ END:VEVENT ;; testcase: dtstart is mandatory (should (null (icalendar--convert-tz-offset - '((TZOFFSETFROM nil "+0100") - (TZOFFSETTO nil "+0200") - (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU")) - t))) + '((TZOFFSETFROM nil "+0100") + (TZOFFSETTO nil "+0200") + (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU")) + t))) ;; FIXME: rrule and rdate are NOT mandatory! Must fix code ;; before activating these testcases @@ -830,18 +842,18 @@ SUMMARY:yearly no time "Perform export test." ;; anniversaries (icalendar-tests--test-export - "%%(diary-anniversary 1989 10 3) anniversary no time" - "%%(diary-anniversary 3 10 1989) anniversary no time" - "%%(diary-anniversary 10 3 1989) anniversary no time" + "%%(diary-anniversary 1988 10 3) anniversary no time" + "%%(diary-anniversary 3 10 1988) anniversary no time" + "%%(diary-anniversary 10 3 1988) anniversary no time" "DTSTART;VALUE=DATE:19891003 DTEND;VALUE=DATE:19891004 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03 SUMMARY:anniversary no time ") (icalendar-tests--test-export - "%%(diary-anniversary 1989 10 3) 19:00-20:00 anniversary with time" - "%%(diary-anniversary 3 10 1989) 19:00-20:00 anniversary with time" - "%%(diary-anniversary 10 3 1989) 19:00-20:00 anniversary with time" + "%%(diary-anniversary 1988 10 3) 19:00-20:00 anniversary with time" + "%%(diary-anniversary 3 10 1988) 19:00-20:00 anniversary with time" + "%%(diary-anniversary 10 3 1988) 19:00-20:00 anniversary with time" "DTSTART;VALUE=DATE-TIME:19891003T190000 DTEND;VALUE=DATE-TIME:19891004T200000 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03 @@ -891,12 +903,12 @@ SUMMARY:no alarm " nil) - ;; 10 minutes in advance, audio - (icalendar-tests--test-export - "2014 Nov 17 19:30 audio alarm" - "17 Nov 2014 19:30 audio alarm" - "Nov 17 2014 19:30 audio alarm" - "DTSTART;VALUE=DATE-TIME:20141117T193000 + ;; 10 minutes in advance, audio + (icalendar-tests--test-export + "2014 Nov 17 19:30 audio alarm" + "17 Nov 2014 19:30 audio alarm" + "Nov 17 2014 19:30 audio alarm" + "DTSTART;VALUE=DATE-TIME:20141117T193000 DTEND;VALUE=DATE-TIME:20141117T203000 SUMMARY:audio alarm BEGIN:VALARM @@ -904,14 +916,14 @@ ACTION:AUDIO TRIGGER:-PT10M END:VALARM " - '(10 ((audio)))) + '(10 ((audio)))) - ;; 20 minutes in advance, display - (icalendar-tests--test-export - "2014 Nov 17 19:30 display alarm" - "17 Nov 2014 19:30 display alarm" - "Nov 17 2014 19:30 display alarm" - "DTSTART;VALUE=DATE-TIME:20141117T193000 + ;; 20 minutes in advance, display + (icalendar-tests--test-export + "2014 Nov 17 19:30 display alarm" + "17 Nov 2014 19:30 display alarm" + "Nov 17 2014 19:30 display alarm" + "DTSTART;VALUE=DATE-TIME:20141117T193000 DTEND;VALUE=DATE-TIME:20141117T203000 SUMMARY:display alarm BEGIN:VALARM @@ -920,14 +932,14 @@ TRIGGER:-PT20M DESCRIPTION:display alarm END:VALARM " - '(20 ((display)))) + '(20 ((display)))) - ;; 66 minutes in advance, email - (icalendar-tests--test-export - "2014 Nov 17 19:30 email alarm" - "17 Nov 2014 19:30 email alarm" - "Nov 17 2014 19:30 email alarm" - "DTSTART;VALUE=DATE-TIME:20141117T193000 + ;; 66 minutes in advance, email + (icalendar-tests--test-export + "2014 Nov 17 19:30 email alarm" + "17 Nov 2014 19:30 email alarm" + "Nov 17 2014 19:30 email alarm" + "DTSTART;VALUE=DATE-TIME:20141117T193000 DTEND;VALUE=DATE-TIME:20141117T203000 SUMMARY:email alarm BEGIN:VALARM @@ -939,14 +951,14 @@ ATTENDEE:MAILTO:att.one@email.com ATTENDEE:MAILTO:att.two@email.com END:VALARM " - '(66 ((email ("att.one@email.com" "att.two@email.com"))))) + '(66 ((email ("att.one@email.com" "att.two@email.com"))))) - ;; 2 minutes in advance, all alarms - (icalendar-tests--test-export - "2014 Nov 17 19:30 all alarms" - "17 Nov 2014 19:30 all alarms" - "Nov 17 2014 19:30 all alarms" - "DTSTART;VALUE=DATE-TIME:20141117T193000 + ;; 2 minutes in advance, all alarms + (icalendar-tests--test-export + "2014 Nov 17 19:30 all alarms" + "17 Nov 2014 19:30 all alarms" + "Nov 17 2014 19:30 all alarms" + "DTSTART;VALUE=DATE-TIME:20141117T193000 DTEND;VALUE=DATE-TIME:20141117T203000 SUMMARY:all alarms BEGIN:VALARM @@ -967,7 +979,7 @@ TRIGGER:-PT2M DESCRIPTION:all alarms END:VALARM " - '(2 ((email ("att.one@email.com" "att.two@email.com")) (audio) (display))))) + '(2 ((email ("att.one@email.com" "att.two@email.com")) (audio) (display))))) ;; ====================================================================== ;; Import tests @@ -1247,7 +1259,7 @@ Argument INPUT icalendar event string." (find-file temp-ics) (goto-char (point-min)) ;;(when (re-search-forward "\nUID:.*\n" nil t) - ;;(replace-match "\n")) + ;;(replace-match "\n")) (let ((cycled (buffer-substring-no-properties (point-min) (point-max)))) (should (string= org-input cycled))))) ;; clean up @@ -1276,8 +1288,8 @@ DESCRIPTION:beschreibung! LOCATION:nowhere ORGANIZER:ulf ") - (icalendar-tests--test-cycle - "UID:4711 + (icalendar-tests--test-cycle + "UID:4711 DTSTART;VALUE=DATE:19190909 DTEND;VALUE=DATE:19190910 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=09 @@ -1377,7 +1389,7 @@ SUMMARY:ff") " >>> anniversaries: -%%(diary-anniversary 3 28 1991) aa birthday (%d years old)" +%%(diary-anniversary 3 28 1990) aa birthday (%d years old)" "DTSTART;VALUE=DATE:19910328 DTEND;VALUE=DATE:19910329 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=03;BYMONTHDAY=28 @@ -1387,7 +1399,7 @@ SUMMARY:aa birthday (%d years old) (icalendar-tests--test-export nil nil - "%%(diary-anniversary 5 17 1957) bb birthday (%d years old)" + "%%(diary-anniversary 5 17 1956) bb birthday (%d years old)" "DTSTART;VALUE=DATE:19570517 DTEND;VALUE=DATE:19570518 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=05;BYMONTHDAY=17 @@ -1396,7 +1408,7 @@ SUMMARY:bb birthday (%d years old)") (icalendar-tests--test-export nil nil - "%%(diary-anniversary 6 8 1997) cc birthday (%d years old)" + "%%(diary-anniversary 6 8 1996) cc birthday (%d years old)" "DTSTART;VALUE=DATE:19970608 DTEND;VALUE=DATE:19970609 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=06;BYMONTHDAY=08 @@ -1405,7 +1417,7 @@ SUMMARY:cc birthday (%d years old)") (icalendar-tests--test-export nil nil - "%%(diary-anniversary 7 22 1983) dd (%d years ago...!)" + "%%(diary-anniversary 7 22 1982) dd (%d years ago...!)" "DTSTART;VALUE=DATE:19830722 DTEND;VALUE=DATE:19830723 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=07;BYMONTHDAY=22 @@ -1414,7 +1426,7 @@ SUMMARY:dd (%d years ago...!)") (icalendar-tests--test-export nil nil - "%%(diary-anniversary 8 1 1988) ee birthday (%d years old)" + "%%(diary-anniversary 8 1 1987) ee birthday (%d years old)" "DTSTART;VALUE=DATE:19880801 DTEND;VALUE=DATE:19880802 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=08;BYMONTHDAY=01 @@ -1423,7 +1435,7 @@ SUMMARY:ee birthday (%d years old)") (icalendar-tests--test-export nil nil - "%%(diary-anniversary 9 21 1957) ff birthday (%d years old)" + "%%(diary-anniversary 9 21 1956) ff birthday (%d years old)" "DTSTART;VALUE=DATE:19570921 DTEND;VALUE=DATE:19570922 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=21 From d41a4ad4ae6f25c3cbc90aaaa33781821bb655c5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Feb 2021 12:07:52 -0500 Subject: [PATCH 221/297] * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Warn on empty let bodies --- lisp/emacs-lisp/macroexp.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 13ff5ef2eda..0934e43e66a 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -299,7 +299,12 @@ Assumes the caller has bound `macroexpand-all-environment'." (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) dontcare)) (macroexp--cons fun (macroexp--cons (macroexp--all-clauses bindings 1) - (macroexp--all-forms body) + (if (null body) + (macroexp-unprogn + (macroexp--warn-and-return + (format "Empty %s body" fun) + nil t)) + (macroexp--all-forms body)) (cdr form)) form)) (`(,(and fun `(lambda . ,_)) . ,args) From 2106b12fa751094d1b754b50e6dcad2a19e8f02a Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 15 Feb 2021 21:50:38 +0000 Subject: [PATCH 222/297] ; Fix last change in simple.el. --- lisp/simple.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 8a9f46cef6c..215f4399f4a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1906,14 +1906,14 @@ to get different commands to edit and resubmit." (defcustom read-extended-command-predicate #'completion-default-include-p "Predicate to use to determine which commands to include when completing. -The predicate function is called with two parameter: The +The predicate function is called with two parameters: The symbol (i.e., command) in question that should be included or not, and the current buffer. The predicate should return non-nil if the command should be present when doing `M-x TAB'." :version "28.1" - :type '(choice (const :tag "Exclude commands not relevant to the current mode" - #'completion-default-include-p) - (const :tag "All commands" (lambda (_ _) t)) + :type `(choice (const :tag "Exclude commands not relevant to the current mode" + completion-default-include-p) + (const :tag "All commands" ,(lambda (_s _b) t)) (function :tag "Other function"))) (defun read-extended-command () From 83d9fbe3bb8ffdf9e4719842e2510a8dbde86f78 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Feb 2021 21:25:15 -0500 Subject: [PATCH 223/297] * lisp/emacs-lisp/bindat.el (bindat-spec): New macro. It's basically an alias for `quote`, but it offers the advantage of providing Edebug support and opens the possibility of compiling the bindat spec to ELisp code. * doc/lispref/processes.texi (Bindat Spec): Document `bindat-spec`. (Bindat Functions): Tweak a few things to adjust to the state of the code. * test/lisp/emacs-lisp/bindat-tests.el: Use it. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests--read): New function. (edebug-tests--&rest-behavior): New test. --- doc/lispref/processes.texi | 28 +++++++------ etc/NEWS | 2 + lisp/emacs-lisp/bindat.el | 59 +++++++++++++++++++++++----- test/lisp/emacs-lisp/bindat-tests.el | 9 +++-- test/lisp/emacs-lisp/edebug-tests.el | 17 ++++++++ 5 files changed, 91 insertions(+), 24 deletions(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 83461656063..661e56d2762 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -3368,6 +3368,11 @@ processed, and how to pack or unpack it. We normally keep bindat specs in variables whose names end in @samp{-bindat-spec}; that kind of name is automatically recognized as risky. +@defmac bindat-spec &rest specs +Creates a Bindat spec object according to the data layout +specification @var{specs}. +@end defmac + @cindex endianness @cindex big endian @cindex little endian @@ -3398,7 +3403,6 @@ Unsigned integer in network byte order, with length 3. @itemx dword @itemx long Unsigned integer in network byte order, with length 4. -Note: These values may be limited by Emacs's integer implementation limits. @item u16r @itemx u24r @@ -3534,16 +3538,16 @@ repetition has completed. @node Bindat Functions @subsection Functions to Unpack and Pack Bytes - In the following documentation, @var{spec} refers to a data layout -specification, @code{bindat-raw} to a byte array, and @var{struct} to an -alist representing unpacked field data. + In the following documentation, @var{spec} refers to a Bindat spec +object as returned from @code{bindat-spec}, @code{raw} to a byte +array, and @var{struct} to an alist representing unpacked field data. -@defun bindat-unpack spec bindat-raw &optional bindat-idx +@defun bindat-unpack spec raw &optional idx @c FIXME? Again, no multibyte? This function unpacks data from the unibyte string or byte -array @code{bindat-raw} +array var{raw} according to @var{spec}. Normally, this starts unpacking at the -beginning of the byte array, but if @var{bindat-idx} is non-@code{nil}, it +beginning of the byte array, but if @var{idx} is non-@code{nil}, it specifies a zero-based starting position to use instead. The value is an alist or nested alist in which each element describes @@ -3576,15 +3580,15 @@ This function returns the total length of the data in @var{struct}, according to @var{spec}. @end defun -@defun bindat-pack spec struct &optional bindat-raw bindat-idx +@defun bindat-pack spec struct &optional raw idx This function returns a byte array packed according to @var{spec} from the data in the alist @var{struct}. It normally creates and fills a -new byte array starting at the beginning. However, if @var{bindat-raw} +new byte array starting at the beginning. However, if @var{raw} is non-@code{nil}, it specifies a pre-allocated unibyte string or vector to -pack into. If @var{bindat-idx} is non-@code{nil}, it specifies the starting -offset for packing into @code{bindat-raw}. +pack into. If @var{idx} is non-@code{nil}, it specifies the starting +offset for packing into var{raw}. -When pre-allocating, you should make sure @code{(length @var{bindat-raw})} +When pre-allocating, you should make sure @code{(length @var{raw})} meets or exceeds the total length to avoid an out-of-range error. @end defun diff --git a/etc/NEWS b/etc/NEWS index 7f32f7bf6a9..3ac9bb21bd8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -357,6 +357,8 @@ the buffer cycles the whole buffer between "only top-level headings", 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 has a new 'bindat-spec' macro to define specs, with Edebug support ** pcase +++ diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index bf01347ae0e..0bb4b870704 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -65,13 +65,15 @@ ;; The corresponding Lisp bindat specification looks like this: ;; ;; (setq header-bindat-spec -;; '((dest-ip ip) +;; (bindat-spec +;; (dest-ip ip) ;; (src-ip ip) ;; (dest-port u16) ;; (src-port u16))) ;; ;; (setq data-bindat-spec -;; '((type u8) +;; (bindat-spec +;; (type u8) ;; (opcode u8) ;; (length u16r) ;; little endian order ;; (id strz 8) @@ -79,7 +81,8 @@ ;; (align 4))) ;; ;; (setq packet-bindat-spec -;; '((header struct header-bindat-spec) +;; (bindat-spec +;; (header struct header-bindat-spec) ;; (items u8) ;; (fill 3) ;; (item repeat (items) @@ -179,7 +182,7 @@ ;; is interpreted by evalling TAG_VAL and then comparing that to ;; each TAG using equal; if a match is found, the corresponding SPEC ;; is used. -;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the +;; If TAG is a form (eval EXPR), EXPR is eval'ed with `tag' bound to the ;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil. ;; Finally, if TAG is t, the corresponding SPEC is used unconditionally. ;; @@ -368,8 +371,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq field (cdr field))) struct) - -;; Calculate bindat-raw length of structured data +;;;; Calculate bindat-raw length of structured data (defvar bindat--fixed-length-alist '((u8 . 1) (byte . 1) @@ -452,13 +454,13 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq bindat-idx (+ bindat-idx len)))))))) (defun bindat-length (spec struct) - "Calculate bindat-raw length for STRUCT according to bindat SPEC." + "Calculate `bindat-raw' length for STRUCT according to bindat SPEC." (let ((bindat-idx 0)) (bindat--length-group struct spec) bindat-idx)) -;; Pack structured data into bindat-raw +;;;; Pack structured data into bindat-raw (defun bindat--pack-u8 (v) (aset bindat-raw bindat-idx (logand v 255)) @@ -623,8 +625,47 @@ Optional fourth arg IDX is the starting offset into RAW." (bindat--pack-group struct spec) (if raw nil bindat-raw))) +;;;; Debugging support -;; Misc. format conversions +(def-edebug-elem-spec 'bindat-spec '(&rest bindat-item)) + +(def-edebug-elem-spec 'bindat-item + '(([&optional bindat-field] + &or ["eval" form] + ["fill" bindat-len] + ["align" bindat-len] + ["struct" form] ;A reference to another bindat-spec. + ["union" bindat-tag-val &rest (bindat-tag bindat-spec)] + ["repeat" integerp bindat-spec] + bindat-type))) + +(def-edebug-elem-spec 'bindat-type + '(&or ("eval" form) + ["str" bindat-len] + ["strz" bindat-len] + ["vec" bindat-len &optional bindat-type] + ["bits" bindat-len] + symbolp)) + +(def-edebug-elem-spec 'bindat-field + '(&or ("eval" form) symbolp)) + +(def-edebug-elem-spec 'bindat-len '(&or [] "nil" bindat-arg)) + +(def-edebug-elem-spec 'bindat-tag-val '(bindat-arg)) + +(def-edebug-elem-spec 'bindat-tag '(&or ("eval" form) atom)) + +(def-edebug-elem-spec 'bindat-arg + '(&or ("eval" form) integerp (&rest symbolp integerp))) + +(defmacro bindat-spec (&rest fields) + "Build the bindat spec described by FIELDS." + (declare (indent 0) (debug (bindat-spec))) + ;; FIXME: We should really "compile" this to a triplet of functions! + `',fields) + +;;;; Misc. format conversions (defun bindat-format-vector (vect fmt sep &optional len) "Format vector VECT using element format FMT and separator SEP. diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index a9a881987c0..72883fc2ec7 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el @@ -24,13 +24,15 @@ (require 'cl-lib) (defvar header-bindat-spec - '((dest-ip ip) + (bindat-spec + (dest-ip ip) (src-ip ip) (dest-port u16) (src-port u16))) (defvar data-bindat-spec - '((type u8) + (bindat-spec + (type u8) (opcode u8) (length u16r) ;; little endian order (id strz 8) @@ -38,7 +40,8 @@ (align 4))) (defvar packet-bindat-spec - '((header struct header-bindat-spec) + (bindat-spec + (header struct header-bindat-spec) (items u8) (fill 3) (item repeat (items) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index d81376e45ec..daac43372ac 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -970,6 +970,23 @@ primary ones (Bug#42671)." (eval '(setf (edebug-test-code-use-gv-expander (cons 'a 'b)) 3) t)) "(func")))) +(defun edebug-tests--read (form spec) + (with-temp-buffer + (print form (current-buffer)) + (goto-char (point-min)) + (cl-letf ((edebug-all-forms t) + ((get (car form) 'edebug-form-spec) spec)) + (edebug--read nil (current-buffer))))) + +(ert-deftest edebug-tests--&rest-behavior () + ;; `&rest' is documented to allow the last "repetition" to be aborted early. + (should (edebug-tests--read '(dummy x 1 y 2 z) + '(&rest symbolp integerp))) + ;; `&rest' should notice here that the "symbolp integerp" sequence + ;; is not respected. + (should-error (edebug-tests--read '(dummy x 1 2 y) + '(&rest symbolp integerp)))) + (ert-deftest edebug-tests-cl-flet () "Check that Edebug can instrument `cl-flet' forms without name clashes (Bug#41853)." From a0b35e2f80df98a3789286af8f68e85fddf368db Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Feb 2021 23:22:09 -0500 Subject: [PATCH 224/297] * lisp/emacs-lisp/bindat.el: Clarify when field labels are optional The fixes the doc and the Edebug spec, as well as a subtle issue in the code where a field whose name is (eval 'fill) was mistakenly considered as an anonymous field of type `fill`. (bindat--unpack-item, bindat--unpack-group, bindat--length-group) (bindat--pack-item, bindat--pack-group): Use dotimes, dolist, and pcase. (bindat--item-aux): New edebug elem. (bindat-item): Use it to fix the handling of optional fields. (bindat-format-vector): Use `mapconcat`. --- lisp/emacs-lisp/bindat.el | 217 ++++++++++++++++++-------------------- 1 file changed, 102 insertions(+), 115 deletions(-) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 0bb4b870704..eafcdc77606 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -129,13 +129,13 @@ ;; SPEC ::= ( ITEM... ) -;; ITEM ::= ( [FIELD] TYPE ) +;; ITEM ::= ( FIELD TYPE ) ;; | ( [FIELD] eval FORM ) -- eval FORM for side-effect only ;; | ( [FIELD] fill LEN ) -- skip LEN bytes ;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes ;; | ( [FIELD] struct SPEC_NAME ) ;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] ) -;; | ( [FIELD] repeat COUNT ITEM... ) +;; | ( FIELD repeat ARG ITEM... ) ;; -- In (eval EXPR), the value of the last field is available in ;; the dynamically bound variable `last' and all the previous @@ -151,7 +151,7 @@ ;; | strz LEN -- LEN byte (zero-terminated) string ;; | vec LEN [TYPE] -- vector of LEN items of TYPE (default: u8) ;; | ip -- 4 byte vector -;; | bits LEN -- List with bits set in LEN bytes. +;; | bits LEN -- bit vector using LEN bytes. ;; ;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13) ;; and 0x1c 0x28 to (3 5 10 11 12). @@ -226,22 +226,22 @@ (defun bindat--unpack-item (type len &optional vectype) (if (eq type 'ip) (setq type 'vec len 4)) - (cond - ((memq type '(u8 byte)) + (pcase type + ((or 'u8 'byte) (bindat--unpack-u8)) - ((memq type '(u16 word short)) + ((or 'u16 'word 'short) (bindat--unpack-u16)) - ((eq type 'u24) + ('u24 (bindat--unpack-u24)) - ((memq type '(u32 dword long)) + ((or 'u32 'dword 'long) (bindat--unpack-u32)) - ((eq type 'u16r) + ('u16r (bindat--unpack-u16r)) - ((eq type 'u24r) + ('u24r (bindat--unpack-u24r)) - ((eq type 'u32r) + ('u32r (bindat--unpack-u32r)) - ((eq type 'bits) + ('bits (let ((bits nil) (bnum (1- (* 8 len))) j m) (while (>= bnum 0) (if (= (setq m (bindat--unpack-u8)) 0) @@ -253,12 +253,12 @@ (setq bnum (1- bnum) j (ash j -1))))) bits)) - ((eq type 'str) + ('str (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len)))) (setq bindat-idx (+ bindat-idx len)) (if (stringp s) s (apply #'unibyte-string s)))) - ((eq type 'strz) + ('strz (let ((i 0) s) (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0)) (setq i (1+ i))) @@ -266,34 +266,29 @@ (setq bindat-idx (+ bindat-idx len)) (if (stringp s) s (apply #'unibyte-string s)))) - ((eq type 'vec) - (let ((v (make-vector len 0)) (i 0) (vlen 1)) + ('vec + (let ((v (make-vector len 0)) (vlen 1)) (if (consp vectype) (setq vlen (nth 1 vectype) vectype (nth 2 vectype)) (setq type (or vectype 'u8) vectype nil)) - (while (< i len) - (aset v i (bindat--unpack-item type vlen vectype)) - (setq i (1+ i))) + (dotimes (i len) + (aset v i (bindat--unpack-item type vlen vectype))) v)) - (t nil))) + (_ nil))) (defun bindat--unpack-group (spec) (with-suppressed-warnings ((lexical struct last)) (defvar struct) (defvar last)) (let (struct last) - (while spec - (let* ((item (car spec)) - (field (car item)) + (dolist (item spec) + (let* ((field (car item)) (type (nth 1 item)) (len (nth 2 item)) (vectype (and (eq type 'vec) (nth 3 item))) (tail 3) data) - (setq spec (cdr spec)) - (if (and (consp field) (eq (car field) 'eval)) - (setq field (eval (car (cdr field)) t))) (if (and type (consp type) (eq (car type) 'eval)) (setq type (eval (car (cdr type)) t))) (if (and len (consp len) (eq (car len) 'eval)) @@ -303,29 +298,29 @@ len type type field field nil)) + (if (and (consp field) (eq (car field) 'eval)) + (setq field (eval (car (cdr field)) t))) (if (and (consp len) (not (eq type 'eval))) (setq len (apply #'bindat-get-field struct len))) (if (not len) (setq len 1)) - (cond - ((eq type 'eval) + (pcase type + ('eval (if field (setq data (eval len t)) (eval len t))) - ((eq type 'fill) + ('fill (setq bindat-idx (+ bindat-idx len))) - ((eq type 'align) + ('align (while (/= (% bindat-idx len) 0) (setq bindat-idx (1+ bindat-idx)))) - ((eq type 'struct) + ('struct (setq data (bindat--unpack-group (eval len t)))) - ((eq type 'repeat) - (let ((index 0) (count len)) - (while (< index count) - (push (bindat--unpack-group (nthcdr tail item)) data) - (setq index (1+ index))) - (setq data (nreverse data)))) - ((eq type 'union) + ('repeat + (dotimes (_ len) + (push (bindat--unpack-group (nthcdr tail item)) data)) + (setq data (nreverse data))) + ('union (with-suppressed-warnings ((lexical tag)) (defvar tag)) (let ((tag len) (cases (nthcdr tail item)) case cc) @@ -337,7 +332,8 @@ (and (consp cc) (eval cc t))) (setq data (bindat--unpack-group (cdr case)) cases nil))))) - (t + ((pred integerp) (debug t)) + (_ (setq data (bindat--unpack-item type len vectype) last data))) (if data @@ -384,16 +380,12 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (with-suppressed-warnings ((lexical struct last)) (defvar struct) (defvar last)) (let ((struct struct) last) - (while spec - (let* ((item (car spec)) - (field (car item)) + (dolist (item spec) + (let* ((field (car item)) (type (nth 1 item)) (len (nth 2 item)) (vectype (and (eq type 'vec) (nth 3 item))) (tail 3)) - (setq spec (cdr spec)) - (if (and (consp field) (eq (car field) 'eval)) - (setq field (eval (car (cdr field)) t))) (if (and type (consp type) (eq (car type) 'eval)) (setq type (eval (car (cdr type)) t))) (if (and len (consp len) (eq (car len) 'eval)) @@ -403,6 +395,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." len type type field field nil)) + (if (and (consp field) (eq (car field) 'eval)) + (setq field (eval (car (cdr field)) t))) (if (and (consp len) (not (eq type 'eval))) (setq len (apply #'bindat-get-field struct len))) (if (not len) @@ -413,27 +407,25 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." type (nth 2 vectype)) (setq type (or vectype 'u8) vectype nil))) - (cond - ((eq type 'eval) + (pcase type + ('eval (if field (setq struct (cons (cons field (eval len t)) struct)) (eval len t))) - ((eq type 'fill) + ('fill (setq bindat-idx (+ bindat-idx len))) - ((eq type 'align) + ('align (while (/= (% bindat-idx len) 0) (setq bindat-idx (1+ bindat-idx)))) - ((eq type 'struct) + ('struct (bindat--length-group (if field (bindat-get-field struct field) struct) (eval len t))) - ((eq type 'repeat) - (let ((index 0) (count len)) - (while (< index count) - (bindat--length-group - (nth index (bindat-get-field struct field)) - (nthcdr tail item)) - (setq index (1+ index))))) - ((eq type 'union) + ('repeat + (dotimes (index len) + (bindat--length-group + (nth index (bindat-get-field struct field)) + (nthcdr tail item)))) + ('union (with-suppressed-warnings ((lexical tag)) (defvar tag)) (let ((tag len) (cases (nthcdr tail item)) case cc) @@ -446,7 +438,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (progn (bindat--length-group struct (cdr case)) (setq cases nil)))))) - (t + (_ (if (setq type (assq type bindat--fixed-length-alist)) (setq len (* len (cdr type)))) (if field @@ -495,24 +487,24 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (defun bindat--pack-item (v type len &optional vectype) (if (eq type 'ip) (setq type 'vec len 4)) - (cond - ((null v) + (pcase type + ((guard (null v)) (setq bindat-idx (+ bindat-idx len))) - ((memq type '(u8 byte)) + ((or 'u8 'byte) (bindat--pack-u8 v)) - ((memq type '(u16 word short)) + ((or 'u16 'word 'short) (bindat--pack-u16 v)) - ((eq type 'u24) + ('u24 (bindat--pack-u24 v)) - ((memq type '(u32 dword long)) + ((or 'u32 'dword 'long) (bindat--pack-u32 v)) - ((eq type 'u16r) + ('u16r (bindat--pack-u16r v)) - ((eq type 'u24r) + ('u24r (bindat--pack-u24r v)) - ((eq type 'u32r) + ('u32r (bindat--pack-u32r v)) - ((eq type 'bits) + ('bits (let ((bnum (1- (* 8 len))) j m) (while (>= bnum 0) (setq m 0) @@ -525,41 +517,35 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq bnum (1- bnum) j (ash j -1)))) (bindat--pack-u8 m)))) - ((memq type '(str strz)) - (let ((l (length v)) (i 0)) + ((or 'str 'strz) + (let ((l (length v))) (if (> l len) (setq l len)) - (while (< i l) - (aset bindat-raw (+ bindat-idx i) (aref v i)) - (setq i (1+ i))) + (dotimes (i l) + (aset bindat-raw (+ bindat-idx i) (aref v i))) (setq bindat-idx (+ bindat-idx len)))) - ((eq type 'vec) - (let ((l (length v)) (i 0) (vlen 1)) + ('vec + (let ((l (length v)) (vlen 1)) (if (consp vectype) (setq vlen (nth 1 vectype) vectype (nth 2 vectype)) (setq type (or vectype 'u8) vectype nil)) (if (> l len) (setq l len)) - (while (< i l) - (bindat--pack-item (aref v i) type vlen vectype) - (setq i (1+ i))))) - (t + (dotimes (i l) + (bindat--pack-item (aref v i) type vlen vectype)))) + (_ (setq bindat-idx (+ bindat-idx len))))) (defun bindat--pack-group (struct spec) (with-suppressed-warnings ((lexical struct last)) (defvar struct) (defvar last)) (let ((struct struct) last) - (while spec - (let* ((item (car spec)) - (field (car item)) + (dolist (item spec) + (let* ((field (car item)) (type (nth 1 item)) (len (nth 2 item)) (vectype (and (eq type 'vec) (nth 3 item))) (tail 3)) - (setq spec (cdr spec)) - (if (and (consp field) (eq (car field) 'eval)) - (setq field (eval (car (cdr field)) t))) (if (and type (consp type) (eq (car type) 'eval)) (setq type (eval (car (cdr type)) t))) (if (and len (consp len) (eq (car len) 'eval)) @@ -569,31 +555,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." len type type field field nil)) + (if (and (consp field) (eq (car field) 'eval)) + (setq field (eval (car (cdr field)) t))) (if (and (consp len) (not (eq type 'eval))) (setq len (apply #'bindat-get-field struct len))) (if (not len) (setq len 1)) - (cond - ((eq type 'eval) + (pcase type + ('eval (if field (setq struct (cons (cons field (eval len t)) struct)) (eval len t))) - ((eq type 'fill) + ('fill (setq bindat-idx (+ bindat-idx len))) - ((eq type 'align) + ('align (while (/= (% bindat-idx len) 0) (setq bindat-idx (1+ bindat-idx)))) - ((eq type 'struct) + ('struct (bindat--pack-group (if field (bindat-get-field struct field) struct) (eval len t))) - ((eq type 'repeat) - (let ((index 0) (count len)) - (while (< index count) - (bindat--pack-group - (nth index (bindat-get-field struct field)) - (nthcdr tail item)) - (setq index (1+ index))))) - ((eq type 'union) + ('repeat + (dotimes (index len) + (bindat--pack-group + (nth index (bindat-get-field struct field)) + (nthcdr tail item)))) + ('union (with-suppressed-warnings ((lexical tag)) (defvar tag)) (let ((tag len) (cases (nthcdr tail item)) case cc) @@ -606,7 +592,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (progn (bindat--pack-group struct (cdr case)) (setq cases nil)))))) - (t + (_ (setq last (bindat-get-field struct field)) (bindat--pack-item last type len vectype) )))))) @@ -629,15 +615,21 @@ Optional fourth arg IDX is the starting offset into RAW." (def-edebug-elem-spec 'bindat-spec '(&rest bindat-item)) + +(def-edebug-elem-spec 'bindat--item-aux + ;; Field types which can come without a field label. + '(&or ["eval" form] + ["fill" bindat-len] + ["align" bindat-len] + ["struct" form] ;A reference to another bindat-spec. + ["union" bindat-tag-val &rest (bindat-tag bindat-spec)])) + (def-edebug-elem-spec 'bindat-item - '(([&optional bindat-field] - &or ["eval" form] - ["fill" bindat-len] - ["align" bindat-len] - ["struct" form] ;A reference to another bindat-spec. - ["union" bindat-tag-val &rest (bindat-tag bindat-spec)] - ["repeat" integerp bindat-spec] - bindat-type))) + '((&or bindat--item-aux ;Without label.. + [bindat-field ;..or with label + &or bindat--item-aux + ["repeat" bindat-arg bindat-spec] + bindat-type]))) (def-edebug-elem-spec 'bindat-type '(&or ("eval" form) @@ -672,13 +664,8 @@ Optional fourth arg IDX is the starting offset into RAW." Result is a string with each element of VECT formatted using FMT and separated by the string SEP. If optional fourth arg LEN is given, use only that many elements from VECT." - (unless len - (setq len (length vect))) - (let ((i len) (fmt2 (concat sep fmt)) (s nil)) - (while (> i 0) - (setq i (1- i) - s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s))) - (apply #'concat s))) + (when len (setq vect (substring vect 0 len))) + (mapconcat (lambda (x) (format fmt x)) vect sep)) (defun bindat-vector-to-dec (vect &optional sep) "Format vector VECT in decimal format separated by dots. From 9b8cf1a38d100d4b860a52ae0349413a37a211db Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 16 Feb 2021 05:26:24 +0100 Subject: [PATCH 225/297] Fix admin/check-doc-strings for new DEFUN format * admin/check-doc-strings: Various fixes, including for the new DEFUN format. The script still produces a ton of false positives, however. --- admin/check-doc-strings | 57 +++++++++++++++++++++++++++++++++++------ 1 file changed, 49 insertions(+), 8 deletions(-) diff --git a/admin/check-doc-strings b/admin/check-doc-strings index 63856d32871..135090b34ce 100755 --- a/admin/check-doc-strings +++ b/admin/check-doc-strings @@ -59,7 +59,7 @@ sub Check_texi_function { $arglist_parm{$parm} = 1; } - foreach my $parm ($docstring =~ /\@var{([^{}]+)}/g) { + foreach my $parm ($docstring =~ /\@var\{([^{}]+)\}/g) { $docstring_parm{$parm} = 1; } @@ -111,7 +111,9 @@ sub Check_function { # $arglist_parm{$parm} = 1; #} foreach my $parm (@parms) { - next if $parm eq '&optional' || $parm eq '&rest'; + next if $parm eq '&optional' + || $parm eq '&rest' + || $parm eq 'Lisp-Object'; $arglist_parm{$parm} = 1; } my $doc_tmp = $docstring; @@ -150,6 +152,22 @@ sub Check_function { next if $parm eq 'primary'; next if $parm eq 'secondary'; next if $parm eq 'clipboard'; + next if $parm eq 'bbdb'; + next if $parm eq 'dos'; + next if $parm eq 'erc'; + next if $parm eq 'exif'; + next if $parm eq 'ldap'; + next if $parm eq 'ime'; + next if $parm eq 'rfc'; + next if $parm eq 'ms-dos'; + next if $parm eq 'url'; + next if $parm eq 'w32'; + next if $parm eq 'todo'; # org-mode + next if $parm eq 'done'; # org-mode + next if $parm eq 'waiting'; #org-mode + next if $parm eq 'ordered'; #org-mode + next if $parm eq 'deadline'; #org-mode + next if $parm eq 'scheduled'; #org-mode next if length $parm < 3; if (! exists $arglist_parm{$parm}) { print "bogus parm: $function: $parm\n"; @@ -228,20 +246,43 @@ open (FIND, "find src -name '*.c' -print |") or die; while (my $file = ) { my @matches = ((FileContents $file) =~ - /\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo); + /\b + DEFUN\s*\(\s* + ## $function + \"((?:[^\\\"]|\\.)+)\"\s*, + \s*\S+\s*, \s*\S+\s*, + ## $minargs + \s*(\S+)\s*, + ## $maxargs + \s*(\S+)\s*, + ## $interactive + \s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*, + ## $docstring + \s*doc:\s*\/\*\s*(.*?)\s*\*\/ + # attributes -- skip + (?:\s*attributes:\s* + (?:noreturn|const) + \s*)? + \s*\) + ### $parms + \s*\( + ([^()]*) + \) + /sgox); while (@matches) { my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@matches, 0, 6); $docstring =~ s/^\n+//s; $docstring =~ s/\n+$//s; $parms =~ s/,/ /g; - my @parms = split (' ',$parms); + my @parms = $parms eq 'void' ? () : split (' ', $parms); for (@parms) { tr/_/-/; s/-$//; } if ($parms !~ /Lisp_Object/) { if ($minargs < @parms) { - if ($maxargs =~ /^\d+$/) { - die unless $maxargs eq @parms; - splice (@parms, $minargs, 0, '&optional'); - } + if ($maxargs =~ /^\d+$/) { + die "$function: $maxargs" + unless $maxargs eq @parms; + splice (@parms, $minargs, 0, '&optional'); + } } } my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function'); From 62cda6acd61f6de2698674391a26ce0a8672fc93 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Feb 2021 23:54:45 -0500 Subject: [PATCH 226/297] * lisp/emacs-lisp/bindat.el: Add 64bit int support (bindat--unpack-u64, bindat--unpack-u64r, bindat--pack-u64) (bindat--pack-u64r): New functions. (bindat--unpack-item, bindat--pack-item): Use them. (bindat--fixed-length-alist): Add new types. --- doc/lispref/processes.texi | 11 +++++--- etc/NEWS | 5 +++- lisp/emacs-lisp/bindat.el | 51 +++++++++++++++++++++++--------------- 3 files changed, 43 insertions(+), 24 deletions(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 661e56d2762..bb4c57a6196 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -3404,10 +3404,15 @@ Unsigned integer in network byte order, with length 3. @itemx long Unsigned integer in network byte order, with length 4. +@item u64 +Unsigned integer in network byte order, with length 8. + @item u16r @itemx u24r @itemx u32r -Unsigned integer in little endian order, with length 2, 3 and 4, respectively. +@itemx u64r +Unsigned integer in little endian order, with length 2, 3, 4, and +8, respectively. @item str @var{len} String of length @var{len}. @@ -3545,7 +3550,7 @@ array, and @var{struct} to an alist representing unpacked field data. @defun bindat-unpack spec raw &optional idx @c FIXME? Again, no multibyte? This function unpacks data from the unibyte string or byte -array var{raw} +array @var{raw} according to @var{spec}. Normally, this starts unpacking at the beginning of the byte array, but if @var{idx} is non-@code{nil}, it specifies a zero-based starting position to use instead. @@ -3586,7 +3591,7 @@ the data in the alist @var{struct}. It normally creates and fills a new byte array starting at the beginning. However, if @var{raw} is non-@code{nil}, it specifies a pre-allocated unibyte string or vector to pack into. If @var{idx} is non-@code{nil}, it specifies the starting -offset for packing into var{raw}. +offset for packing into @var{raw}. When pre-allocating, you should make sure @code{(length @var{raw})} meets or exceeds the total length to avoid an out-of-range error. diff --git a/etc/NEWS b/etc/NEWS index 3ac9bb21bd8..943ad6ac591 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -357,8 +357,11 @@ the buffer cycles the whole buffer between "only top-level headings", 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 +++ -** Bindat has a new 'bindat-spec' macro to define specs, with Edebug support +*** New types 'u64' and 'u64r' ++++ +*** New macro 'bindat-spec' to define specs, with Edebug support ** pcase +++ diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index eafcdc77606..1f5022c2743 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -146,7 +146,8 @@ ;; | u16 | word | short -- length 2, network byte order ;; | u24 -- 3-byte value ;; | u32 | dword | long -- length 4, network byte order -;; | u16r | u24r | u32r -- little endian byte order. +;; | u64 -- length 8, network byte order +;; | u16r | u24r | u32r | u64r - little endian byte order. ;; | str LEN -- LEN byte string ;; | strz LEN -- LEN byte (zero-terminated) string ;; | vec LEN [TYPE] -- vector of LEN items of TYPE (default: u8) @@ -214,6 +215,9 @@ (defun bindat--unpack-u32 () (logior (ash (bindat--unpack-u16) 16) (bindat--unpack-u16))) +(defun bindat--unpack-u64 () + (logior (ash (bindat--unpack-u32) 32) (bindat--unpack-u32))) + (defun bindat--unpack-u16r () (logior (bindat--unpack-u8) (ash (bindat--unpack-u8) 8))) @@ -223,6 +227,9 @@ (defun bindat--unpack-u32r () (logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16))) +(defun bindat--unpack-u64r () + (logior (bindat--unpack-u32r) (ash (bindat--unpack-u32r) 32))) + (defun bindat--unpack-item (type len &optional vectype) (if (eq type 'ip) (setq type 'vec len 4)) @@ -231,16 +238,14 @@ (bindat--unpack-u8)) ((or 'u16 'word 'short) (bindat--unpack-u16)) - ('u24 - (bindat--unpack-u24)) + ('u24 (bindat--unpack-u24)) ((or 'u32 'dword 'long) (bindat--unpack-u32)) - ('u16r - (bindat--unpack-u16r)) - ('u24r - (bindat--unpack-u24r)) - ('u32r - (bindat--unpack-u32r)) + ('u64 (bindat--unpack-u64)) + ('u16r (bindat--unpack-u16r)) + ('u24r (bindat--unpack-u24r)) + ('u32r (bindat--unpack-u32r)) + ('u64r (bindat--unpack-u64r)) ('bits (let ((bits nil) (bnum (1- (* 8 len))) j m) (while (>= bnum 0) @@ -374,6 +379,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (u16 . 2) (u16r . 2) (word . 2) (short . 2) (u24 . 3) (u24r . 3) (u32 . 4) (u32r . 4) (dword . 4) (long . 4) + (u64 . 8) (u64r . 8) (ip . 4))) (defun bindat--length-group (struct spec) @@ -471,6 +477,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-u16 (ash v -16)) (bindat--pack-u16 v)) +(defun bindat--pack-u64 (v) + (bindat--pack-u32 (ash v -32)) + (bindat--pack-u32 v)) + (defun bindat--pack-u16r (v) (aset bindat-raw (1+ bindat-idx) (logand (ash v -8) 255)) (aset bindat-raw bindat-idx (logand v 255)) @@ -484,6 +494,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-u16r v) (bindat--pack-u16r (ash v -16))) +(defun bindat--pack-u64r (v) + (bindat--pack-u32r v) + (bindat--pack-u32r (ash v -32))) + (defun bindat--pack-item (v type len &optional vectype) (if (eq type 'ip) (setq type 'vec len 4)) @@ -498,12 +512,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-u24 v)) ((or 'u32 'dword 'long) (bindat--pack-u32 v)) - ('u16r - (bindat--pack-u16r v)) - ('u24r - (bindat--pack-u24r v)) - ('u32r - (bindat--pack-u32r v)) + ('u64 (bindat--pack-u64 v)) + ('u16r (bindat--pack-u16r v)) + ('u24r (bindat--pack-u24r v)) + ('u32r (bindat--pack-u32r v)) + ('u64r (bindat--pack-u64r v)) ('bits (let ((bnum (1- (* 8 len))) j m) (while (>= bnum 0) @@ -518,11 +531,9 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." j (ash j -1)))) (bindat--pack-u8 m)))) ((or 'str 'strz) - (let ((l (length v))) - (if (> l len) (setq l len)) - (dotimes (i l) - (aset bindat-raw (+ bindat-idx i) (aref v i))) - (setq bindat-idx (+ bindat-idx len)))) + (dotimes (i (min len (length v))) + (aset bindat-raw (+ bindat-idx i) (aref v i))) + (setq bindat-idx (+ bindat-idx len))) ('vec (let ((l (length v)) (vlen 1)) (if (consp vectype) From 9f843572d2feb4c75bd4f1d2a86edc7595591dc9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 16 Feb 2021 09:56:17 +0100 Subject: [PATCH 227/297] * lisp/play/gomoku.el: Minor doc fixes; formatting. --- lisp/play/gomoku.el | 77 ++++++++++++++++++++++----------------------- 1 file changed, 38 insertions(+), 39 deletions(-) diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index 8db40d7f94f..61b67aeb70d 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -28,39 +28,36 @@ ;; RULES: ;; ;; Gomoku is a game played between two players on a rectangular board. Each -;; player, in turn, marks a free square of its choice. The winner is the first +;; player, in turn, marks a free square of its choice. The winner is the first ;; one to mark five contiguous squares in any direction (horizontally, ;; vertically or diagonally). ;; ;; I have been told that, in "The TRUE Gomoku", some restrictions are made ;; about the squares where one may play, or else there is a known forced win -;; for the first player. This program has no such restriction, but it does not +;; for the first player. This program has no such restriction, but it does not ;; know about the forced win, nor do I. -;; See http://renju.se/rif/r1rulhis.htm for more information. - +;; See https://renju.se/rif/r1rulhis.htm for more information. ;; There are two main places where you may want to customize the program: key -;; bindings and board display. These features are commented in the code. Go +;; bindings and board display. These features are commented in the code. Go ;; and see. - ;; HOW TO USE: ;; -;; The command "M-x gomoku" displays a -;; board, the size of which depends on the size of the current window. The -;; size of the board is easily modified by giving numeric arguments to the -;; gomoku command and/or by customizing the displaying parameters. +;; The command `M-x gomoku' displays a board, the size of which depends on the +;; size of the current window. The size of the board is easily modified by +;; giving numeric arguments to the gomoku command and/or by customizing the +;; displaying parameters. ;; -;; Emacs plays when it is its turn. When it is your turn, just put the cursor +;; Emacs plays when it is its turn. When it is your turn, just put the cursor ;; on the square where you want to play and hit RET, or X, or whatever key you -;; bind to the command gomoku-human-plays. When it is your turn, Emacs is +;; bind to the command `gomoku-human-plays'. When it is your turn, Emacs is ;; idle: you may switch buffers, read your mail, ... Just come back to the ;; *Gomoku* buffer and resume play. - ;; ALGORITHM: ;; -;; The algorithm is briefly described in section "THE SCORE TABLE". Some +;; The algorithm is briefly described in section "THE SCORE TABLE". Some ;; parameters may be modified if you want to change the style exhibited by the ;; program. @@ -86,13 +83,15 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces." "Name of the Gomoku buffer.") ;; You may change these values if you have a small screen or if the squares -;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1). +;; look rectangular. (defconst gomoku-square-width 4 - "Horizontal spacing between squares on the Gomoku board.") + "Horizontal spacing between squares on the Gomoku board. +SHOULD be at least 2 (MUST BE at least 1).") (defconst gomoku-square-height 2 - "Vertical spacing between squares on the Gomoku board.") + "Vertical spacing between squares on the Gomoku board. +SHOULD be at least 2 (MUST BE at least 1).") (defconst gomoku-x-offset 3 "Number of columns between the Gomoku board and the side of the window.") @@ -270,13 +269,13 @@ Other useful commands:\n ;; internested 5-tuples of contiguous squares (called qtuples). ;; ;; The aim of the program is to fill one qtuple with its O's while preventing -;; you from filling another one with your X's. To that effect, it computes a -;; score for every qtuple, with better qtuples having better scores. Of +;; you from filling another one with your X's. To that effect, it computes a +;; score for every qtuple, with better qtuples having better scores. Of ;; course, the score of a qtuple (taken in isolation) is just determined by -;; its contents as a set, i.e. not considering the order of its elements. The +;; its contents as a set, i.e. not considering the order of its elements. The ;; highest score is given to the "OOOO" qtuples because playing in such a -;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because -;; not playing in it is just losing the game, and so on. Note that a +;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because +;; not playing in it is just losing the game, and so on. Note that a ;; "polluted" qtuple, i.e. one containing at least one X and at least one O, ;; has score zero because there is no more any point in playing in it, from ;; both an attacking and a defending point of view. @@ -284,11 +283,11 @@ Other useful commands:\n ;; Given the score of every qtuple, the score of a given free square on the ;; board is just the sum of the scores of all the qtuples to which it belongs, ;; because playing in that square is playing in all its containing qtuples at -;; once. And it is that function which takes into account the internesting of +;; once. And it is that function which takes into account the internesting of ;; the qtuples. ;; ;; This algorithm is rather simple but anyway it gives a not so dumb level of -;; play. It easily extends to "n-dimensional Gomoku", where a win should not +;; play. It easily extends to "n-dimensional Gomoku", where a win should not ;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !) ;; should be preferred. @@ -323,8 +322,8 @@ Other useful commands:\n ;; because "a" mainly belongs to six "XX" qtuples (the others are less ;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other ;; conditions are required to obtain sensible moves, but the previous example -;; should illustrate the point. If you manage to improve on these values, -;; please send me a note. Thanks. +;; should illustrate the point. If you manage to improve on these values, +;; please send me a note. Thanks. ;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the @@ -343,9 +342,9 @@ Other useful commands:\n ;; If you do not modify drastically the previous constants, the only way for a ;; square to have a score higher than gomoku-OOOOscore is to belong to a "OOOO" -;; qtuple, thus to be a winning move. Similarly, the only way for a square to +;; qtuple, thus to be a winning move. Similarly, the only way for a square to ;; have a score between gomoku-XXXXscore and gomoku-OOOOscore is to belong to a "XXXX" -;; qtuple. We may use these considerations to detect when a given move is +;; qtuple. We may use these considerations to detect when a given move is ;; winning or losing. (defconst gomoku-winning-threshold gomoku-OOOOscore @@ -357,8 +356,8 @@ Other useful commands:\n (defun gomoku-strongest-square () "Compute index of free square with highest score, or nil if none." - ;; We just have to loop other all squares. However there are two problems: - ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed + ;; We just have to loop other all squares. However there are two problems: + ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed ;; up future searches, we set the score of padding or occupied squares ;; to -1 whenever we meet them. ;; 2/ We want to choose randomly between equally good moves. @@ -378,7 +377,7 @@ Other useful commands:\n best-square square score-max score) (aset gomoku-score-table square -1))) ; no: kill it ! - ;; If score is equally good, choose randomly. But first check freedom: + ;; If score is equally good, choose randomly. But first check freedom: ((not (zerop (aref gomoku-board square))) (aset gomoku-score-table square -1)) ((zerop (random (setq count (1+ count)))) @@ -392,11 +391,11 @@ Other useful commands:\n ;;; ;; At initialization the board is empty so that every qtuple amounts for -;; gomoku-nil-score. Therefore, the score of any square is gomoku-nil-score times the number -;; of qtuples that pass through it. This number is 3 in a corner and 20 if you -;; are sufficiently far from the sides. As computing the number is time +;; gomoku-nil-score. Therefore, the score of any square is gomoku-nil-score times the number +;; of qtuples that pass through it. This number is 3 in a corner and 20 if you +;; are sufficiently far from the sides. As computing the number is time ;; consuming, we initialize every square with 20*gomoku-nil-score and then only -;; consider squares at less than 5 squares from one side. We speed this up by +;; consider squares at less than 5 squares from one side. We speed this up by ;; taking symmetry into account. ;; Also, as it is likely that successive games will be played on a board with ;; same size, it is a good idea to save the initial SCORE-TABLE configuration. @@ -451,7 +450,7 @@ Other useful commands:\n "Return the number of qtuples containing square I,J." ;; This function is complicated because we have to deal ;; with ugly cases like 3 by 6 boards, but it works. - ;; If you have a simpler (and correct) solution, send it to me. Thanks ! + ;; If you have a simpler (and correct) solution, send it to me. Thanks ! (let ((left (min 4 (1- i))) (right (min 4 (- gomoku-board-width i))) (up (min 4 (1- j))) @@ -477,9 +476,9 @@ Other useful commands:\n ;;; ;; We do not provide functions for computing the SCORE-TABLE given the -;; contents of the BOARD. This would involve heavy nested loops, with time -;; proportional to the size of the board. It is better to update the -;; SCORE-TABLE after each move. Updating needs not modify more than 36 +;; contents of the BOARD. This would involve heavy nested loops, with time +;; proportional to the size of the board. It is better to update the +;; SCORE-TABLE after each move. Updating needs not modify more than 36 ;; squares: it is done in constant time. (defun gomoku-update-score-table (square dval) From 03adc69af708e53d18f4efecbcaaee02f055ef56 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 16 Feb 2021 10:05:03 +0100 Subject: [PATCH 228/297] Do `interactive' mode tagging in gomoku.el * lisp/play/gomoku.el: Do `interactive' mode tagging. --- lisp/play/gomoku.el | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index 61b67aeb70d..0a45885b875 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -781,7 +781,7 @@ Use \\[describe-mode] for more info." (defun gomoku-emacs-plays () "Compute Emacs next move and play it." - (interactive) + (interactive nil gomoku-mode) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing @@ -814,7 +814,7 @@ Use \\[describe-mode] for more info." ;; pixels, event's (X . Y) is a character's top-left corner. (defun gomoku-click (click) "Position at the square where you click." - (interactive "e") + (interactive "e" gomoku-mode) (and (windowp (posn-window (setq click (event-end click)))) (numberp (posn-point click)) (select-window (posn-window click)) @@ -843,7 +843,7 @@ Use \\[describe-mode] for more info." (defun gomoku-mouse-play (click) "Play at the square where you click." - (interactive "e") + (interactive "e" gomoku-mode) (if (gomoku-click click) (gomoku-human-plays))) @@ -851,7 +851,7 @@ Use \\[describe-mode] for more info." "Signal to the Gomoku program that you have played. You must have put the cursor on the square where you want to play. If the game is finished, this command requests for another game." - (interactive) + (interactive nil gomoku-mode) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing @@ -879,7 +879,7 @@ If the game is finished, this command requests for another game." (defun gomoku-human-takes-back () "Signal to the Gomoku program that you wish to take back your last move." - (interactive) + (interactive nil gomoku-mode) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing @@ -903,7 +903,7 @@ If the game is finished, this command requests for another game." (defun gomoku-human-resigns () "Signal to the Gomoku program that you may want to resign." - (interactive) + (interactive nil gomoku-mode) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing @@ -1161,20 +1161,20 @@ If the game is finished, this command requests for another game." ;; the screen. (defun gomoku-move-right () "Move point right one column on the Gomoku board." - (interactive) + (interactive nil gomoku-mode) (when (< (gomoku-point-x) gomoku-board-width) (forward-char gomoku-square-width))) (defun gomoku-move-left () "Move point left one column on the Gomoku board." - (interactive) + (interactive nil gomoku-mode) (when (> (gomoku-point-x) 1) (backward-char gomoku-square-width))) ;; previous-line and next-line don't work right with intangible newlines (defun gomoku-move-down () "Move point down one row on the Gomoku board." - (interactive) + (interactive nil gomoku-mode) (when (< (gomoku-point-y) gomoku-board-height) (let ((column (current-column))) (forward-line gomoku-square-height) @@ -1182,7 +1182,7 @@ If the game is finished, this command requests for another game." (defun gomoku-move-up () "Move point up one row on the Gomoku board." - (interactive) + (interactive nil gomoku-mode) (when (> (gomoku-point-y) 1) (let ((column (current-column))) (forward-line (- gomoku-square-height)) @@ -1190,36 +1190,36 @@ If the game is finished, this command requests for another game." (defun gomoku-move-ne () "Move point North East on the Gomoku board." - (interactive) + (interactive nil gomoku-mode) (gomoku-move-up) (gomoku-move-right)) (defun gomoku-move-se () "Move point South East on the Gomoku board." - (interactive) + (interactive nil gomoku-mode) (gomoku-move-down) (gomoku-move-right)) (defun gomoku-move-nw () "Move point North West on the Gomoku board." - (interactive) + (interactive nil gomoku-mode) (gomoku-move-up) (gomoku-move-left)) (defun gomoku-move-sw () "Move point South West on the Gomoku board." - (interactive) + (interactive nil gomoku-mode) (gomoku-move-down) (gomoku-move-left)) (defun gomoku-beginning-of-line () "Move point to first square on the Gomoku board row." - (interactive) + (interactive nil gomoku-mode) (move-to-column gomoku-x-offset)) (defun gomoku-end-of-line () "Move point to last square on the Gomoku board row." - (interactive) + (interactive nil gomoku-mode) (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- gomoku-board-width))))) From 5b10ca8f4f70cbdc51970b8b756d11f1dbf6e2f6 Mon Sep 17 00:00:00 2001 From: Konstantin Kharlamov Date: Tue, 16 Feb 2021 12:49:30 +0100 Subject: [PATCH 229/297] make smerge-vc-next-conflict wrap around * lisp/vc/smerge-mode.el: (smerge-vc-next-conflict): While searching for conflict markers, wrap search around if current file is the last one with conflicts (bug#46538). --- lisp/vc/smerge-mode.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index c66a4fb2d6a..782c799273c 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1468,12 +1468,12 @@ found, uses VC to try and find the next file with conflict." (if (and (buffer-modified-p) buffer-file-name) (save-buffer)) (vc-find-conflicted-file) - (if (eq buffer (current-buffer)) - ;; Do nothing: presumably `vc-find-conflicted-file' already - ;; emitted a message explaining there aren't any more conflicts. - nil - (goto-char (point-min)) - (smerge-next))))))) + (when (eq buffer (current-buffer)) + ;; Try to find a conflict marker in current file above the point. + (let ((prev-pos (point))) + (goto-char (point-min)) + (unless (ignore-errors (not (smerge-next))) + (goto-char prev-pos))))))))) (provide 'smerge-mode) From b79055e960dfe9419214930594eddd9ae7b9ece7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Feb 2021 14:00:55 +0100 Subject: [PATCH 230/297] Don't resize images in image-mode if we have a rotation * lisp/image-mode.el (image-fit-to-window): Don't resize of we have a manually rotated imaged (and explain the resizing logic a bit). --- lisp/image-mode.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 9ed295e2aa1..ec0a559c8db 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -985,7 +985,13 @@ Otherwise, display the image by calling `image-mode'." (edges (window-inside-pixel-edges window)) (window-width (- (nth 2 edges) (nth 0 edges))) (window-height (- (nth 3 edges) (nth 1 edges)))) + ;; If the size has been changed manually (with `+'/`-'), + ;; then :max-width/:max-height is nil. In that case, do + ;; no automatic resizing. (when (and image-width image-height + ;; Don't do resizing if we have a manual + ;; rotation (from the `r' command), either. + (not (plist-get (cdr spec) :rotation)) (or (not (= image-width window-width)) (not (= image-height window-height)))) (unless image-fit-to-window-lock From fff138eb3d88e6933a0456a49d38f2850e048f53 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Feb 2021 14:21:52 +0100 Subject: [PATCH 231/297] Do interactive mode tagging for info.el --- lisp/info.el | 79 ++++++++++++++++++++++++++++------------------------ 1 file changed, 42 insertions(+), 37 deletions(-) diff --git a/lisp/info.el b/lisp/info.el index 7f169f4b556..e7324efa2f9 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1972,7 +1972,8 @@ If DIRECTION is `backward', search in the reverse direction." (format-prompt "Regexp search%s" (car Info-search-history) (if case-fold-search "" " case-sensitively")) - nil 'Info-search-history))) + nil 'Info-search-history)) + Info-mode) (when (equal regexp "") (setq regexp (car Info-search-history))) (when regexp @@ -2080,13 +2081,13 @@ If DIRECTION is `backward', search in the reverse direction." (defun Info-search-case-sensitively () "Search for a regexp case-sensitively." - (interactive) + (interactive nil Info-mode) (let ((case-fold-search nil)) (call-interactively 'Info-search))) (defun Info-search-next () "Search for next regexp from a previous `Info-search' command." - (interactive) + (interactive nil Info-mode) (let ((case-fold-search Info-search-case-fold)) (if Info-search-history (Info-search (car Info-search-history)) @@ -2098,7 +2099,8 @@ If DIRECTION is `backward', search in the reverse direction." (format-prompt "Regexp search%s backward" (car Info-search-history) (if case-fold-search "" " case-sensitively")) - nil 'Info-search-history))) + nil 'Info-search-history)) + Info-mode) (Info-search regexp bound noerror count 'backward)) (defun Info-isearch-search () @@ -2235,7 +2237,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat." (defun Info-next () "Go to the \"next\" node, staying on the same hierarchical level. This command doesn't descend into sub-nodes, like \\\\[Info-forward-node] does." - (interactive) + (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) @@ -2244,7 +2246,7 @@ This command doesn't descend into sub-nodes, like \\\\[Info-forwa (defun Info-prev () "Go to the \"previous\" node, staying on the same hierarchical level. This command doesn't go up to the parent node, like \\\\[Info-backward-node] does." - (interactive) + (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) @@ -2253,7 +2255,7 @@ This command doesn't go up to the parent node, like \\\\[Info-bac (defun Info-up (&optional same-file) "Go to the superior node of this node. If SAME-FILE is non-nil, do not move to a different Info file." - (interactive) + (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) @@ -2284,7 +2286,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." (defun Info-history-back () "Go back in the history to the last node visited." - (interactive) + (interactive nil Info-mode) (or Info-history (user-error "This is the first Info node you looked at")) (let ((history-forward @@ -2304,7 +2306,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." (defun Info-history-forward () "Go forward in the history of visited nodes." - (interactive) + (interactive nil Info-mode) (or Info-history-forward (user-error "This is the last Info node you looked at")) (let ((history-forward (cdr Info-history-forward)) @@ -2378,7 +2380,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." (defun Info-history () "Go to a node with a menu of visited nodes." - (interactive) + (interactive nil Info-mode) (Info-find-node "*History*" "Top") (Info-next-reference) (Info-next-reference)) @@ -2415,7 +2417,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." (defun Info-toc () "Go to a node with table of contents of the current Info file. Table of contents is created from the tree structure of menus." - (interactive) + (interactive nil Info-mode) (Info-find-node Info-current-file "*TOC*") (let ((prev-node (nth 1 (car Info-history))) p) (goto-char (point-min)) @@ -2587,7 +2589,8 @@ new buffer." (list (if (equal input "") default input) current-prefix-arg)) - (user-error "No cross-references in this node")))) + (user-error "No cross-references in this node"))) + Info-mode) (unless footnotename (error "No reference was specified")) @@ -2789,7 +2792,8 @@ new buffer." (completing-read (format-prompt "Menu item" default) #'Info-complete-menu-item nil t nil nil default)))) - (list item current-prefix-arg)))) + (list item current-prefix-arg))) + Info-mode) ;; there is a problem here in that if several menu items have the same ;; name you can only go to the node of the first with this command. (Info-goto-node (Info-extract-menu-item menu-item) @@ -2833,19 +2837,19 @@ new buffer." (defun Info-nth-menu-item () "Go to the node of the Nth menu item. N is the digit argument used to invoke this command." - (interactive) + (interactive nil Info-mode) (Info-goto-node (Info-extract-menu-counting (- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0)))) (defun Info-top-node () "Go to the Top node of this file." - (interactive) + (interactive nil Info-mode) (Info-goto-node "Top")) (defun Info-final-node () "Go to the final node in this file." - (interactive) + (interactive nil Info-mode) (Info-goto-node "Top") (let ((Info-history nil) (case-fold-search t)) @@ -2869,7 +2873,7 @@ to the parent node. When called from Lisp, NOT-DOWN non-nil means don't descend into sub-nodes, NOT-UP non-nil means don't go to parent nodes, and NO-ERROR non-nil means don't signal a user-error if there's no node to go to." - (interactive) + (interactive nil Info-mode) (goto-char (point-min)) (forward-line 1) (let ((case-fold-search t)) @@ -2906,7 +2910,7 @@ don't signal a user-error if there's no node to go to." "Go backward one node, considering all nodes as forming one sequence. If the current node has a \"previous\" node, go to it, descending into its last sub-node, if any; otherwise go \"up\" to the parent node." - (interactive) + (interactive nil Info-mode) (let ((prevnode (Info-extract-pointer "prev[ious]*" t)) (upnode (Info-extract-pointer "up" t)) (case-fold-search t)) @@ -2935,7 +2939,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node." (defun Info-next-menu-item () "Go to the node of the next menu item." - (interactive) + (interactive nil Info-mode) ;; Bind this in case the user sets it to nil. (let* ((case-fold-search t) (node @@ -2949,7 +2953,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node." (defun Info-last-menu-item () "Go to the node of the previous menu item." - (interactive) + (interactive nil Info-mode) (save-excursion (forward-line 1) ;; Bind this in case the user sets it to nil. @@ -2968,7 +2972,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node." (defun Info-next-preorder () "Go to the next subnode or the next node, or go up a level." - (interactive) + (interactive nil Info-mode) (cond ((Info-no-error (Info-next-menu-item))) ((Info-no-error (Info-next))) ((Info-no-error (Info-up t)) @@ -2987,7 +2991,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node." (defun Info-last-preorder () "Go to the last node, popping up a level if there is none." - (interactive) + (interactive nil Info-mode) (cond ((and Info-scroll-prefer-subnodes (Info-no-error (Info-last-menu-item) @@ -3039,7 +3043,7 @@ the menu of a node, it moves to subnode indicated by the following menu item. (That case won't normally result from this command, but can happen in other ways.)" - (interactive) + (interactive nil Info-mode) (if (or (< (window-start) (point-min)) (> (window-start) (point-max))) (set-window-start (selected-window) (point))) @@ -3061,7 +3065,7 @@ in other ways.)" (defun Info-mouse-scroll-up (e) "Scroll one screenful forward in Info, using the mouse. See `Info-scroll-up'." - (interactive "e") + (interactive "e" Info-mode) (save-selected-window (if (eventp e) (select-window (posn-window (event-start e)))) @@ -3073,7 +3077,7 @@ If point is within the menu of a node, and `Info-scroll-prefer-subnodes' is non-nil, this goes to its last subnode. When you scroll past the beginning of a node, that goes to the previous node or back up to the parent node." - (interactive) + (interactive nil Info-mode) (if (or (< (window-start) (point-min)) (> (window-start) (point-max))) (set-window-start (selected-window) (point))) @@ -3093,7 +3097,7 @@ parent node." (defun Info-mouse-scroll-down (e) "Scroll one screenful backward in Info, using the mouse. See `Info-scroll-down'." - (interactive "e") + (interactive "e" Info-mode) (save-selected-window (if (eventp e) (select-window (posn-window (event-start e)))) @@ -3139,7 +3143,7 @@ Return the new position of point, or nil." "Move cursor to the next cross-reference or menu item in the node. If COUNT is non-nil (interactively with a prefix arg), jump over COUNT cross-references." - (interactive "i\np") + (interactive "i\np" Info-mode) (unless count (setq count 1)) (if (< count 0) @@ -3167,7 +3171,7 @@ COUNT cross-references." "Move cursor to the previous cross-reference or menu item in the node. If COUNT is non-nil (interactively with a prefix arg), jump over COUNT cross-references." - (interactive "i\np") + (interactive "i\np" Info-mode) (unless count (setq count 1)) (if (< count 0) @@ -3365,7 +3369,7 @@ Give an empty topic name to go to the Index node itself." (defun Info-index-next (num) "Go to the next matching index item from the last \\\\[Info-index] command." - (interactive "p") + (interactive "p" Info-mode) (or Info-index-alternatives (user-error "No previous `i' command")) (while (< num 0) @@ -3487,7 +3491,8 @@ search results." (with-current-buffer Info-complete-menu-buffer (Info-goto-index) (completing-read "Index topic: " #'Info-complete-menu-item)) - (kill-buffer Info-complete-menu-buffer))))) + (kill-buffer Info-complete-menu-buffer)))) + Info-mode) (if (equal topic "") (Info-find-node Info-current-file "*Index*") (unless (assoc (cons Info-current-file topic) Info-virtual-index-nodes) @@ -3793,7 +3798,7 @@ with a list of packages that contain all specified keywords." (defun Info-undefined () "Make command be undefined in Info." - (interactive) + (interactive nil Info-mode) (ding)) (defun Info-help () @@ -3870,7 +3875,7 @@ ERRORSTRING optional fourth argument, controls action on no match: "\\Follow a node reference near point. Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where you click. At end of the node's text, moves to the next node, or up if none." - (interactive "e") + (interactive "e" Info-mode) (mouse-set-point click) (and (not (Info-follow-nearest-node)) (save-excursion (forward-line 1) (eobp)) @@ -3884,7 +3889,7 @@ if point is in a menu item description, follow that menu item. If FORK is non-nil (interactively with a prefix arg), show the node in a new Info buffer. If FORK is a string, it is the name to use for the new buffer." - (interactive "P") + (interactive "P" Info-mode) (or (Info-try-follow-nearest-node fork) (when (save-excursion (search-backward "\n* menu:" nil t)) @@ -3954,7 +3959,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (defun Info-mouse-follow-link (click) "Follow a link where you click." - (interactive "@e") + (interactive "@e" Info-mode) (let* ((position (event-start click)) (posn-string (and position (posn-string position))) (link-args (if posn-string @@ -4158,12 +4163,12 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (defun Info-history-back-menu (e) "Pop up the menu with a list of previously visited Info nodes." - (interactive "e") + (interactive "e" Info-mode) (Info-history-menu e "Back in history" Info-history 'Info-history-back)) (defun Info-history-forward-menu (e) "Pop up the menu with a list of Info nodes visited with ‘Info-history-back’." - (interactive "e") + (interactive "e" Info-mode) (Info-history-menu e "Forward in history" Info-history-forward 'Info-history-forward)) (defvar Info-menu-last-node nil) @@ -4237,7 +4242,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'." "Put the name of the current Info node into the kill ring. The name of the Info file is prepended to the node name in parentheses. With a zero prefix arg, put the name inside a function call to `info'." - (interactive "P") + (interactive "P" Info-mode) (unless Info-current-node (user-error "No current Info node")) (let ((node (if (stringp Info-current-file) From c977370dd734be12ffbaf0da2f3db529d6175b62 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 16 Feb 2021 18:20:06 +0200 Subject: [PATCH 232/297] Avoid point movement when visiting image files * lisp/image-mode.el (image-toggle-display-image): Preserve point around the call to exif-parse-buffer, to prevent it from moving into the image data. (Bug#46552) --- lisp/image-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index aee91ee8b21..24be008f3f7 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -829,7 +829,9 @@ was inserted." (setq image-transform-rotation (or (exif-orientation (ignore-error exif-error - (exif-parse-buffer))) + ;; exif-parse-buffer can move point, so preserve it. + (save-excursion + (exif-parse-buffer)))) 0.0))) ;; Swap width and height when changing orientation ;; between portrait and landscape. From 7c7377288a125ef47f2b422cf131f044a3b418e1 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Feb 2021 17:39:03 +0100 Subject: [PATCH 233/297] Fix problem of point movement in image-mode * lisp/image-mode.el (image-mode): Switch disable-point-adjustment on, otherwise `C-c C-c' will move point around oddly. (image-toggle-display): Ensure that point is on the image (bug#46552). --- lisp/image-mode.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index ec0a559c8db..28b75c8113a 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -611,6 +611,7 @@ Key bindings: (major-mode-suspend) (setq major-mode 'image-mode) (setq image-transform-resize image-auto-resize) + (setq-local disable-point-adjustment t) ;; Bail out early if we have no image data. (if (zerop (buffer-size)) @@ -931,6 +932,7 @@ If the current buffer is displaying an image file as an image, call `image-mode-as-text' to switch to text or hex display. Otherwise, display the image by calling `image-mode'." (interactive) + (goto-char (point-min)) (if (image-get-display-property) (image-mode-as-text) (if (eq major-mode 'hexl-mode) From 76220fc3fc8b109d53676c1771fa1f05f3706ac7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Feb 2021 17:42:24 +0100 Subject: [PATCH 234/297] Revert "Fix problem of point movement in image-mode" This reverts commit 7c7377288a125ef47f2b422cf131f044a3b418e1. This is fixed differently in Emacs 27. --- lisp/image-mode.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 28b75c8113a..ec0a559c8db 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -611,7 +611,6 @@ Key bindings: (major-mode-suspend) (setq major-mode 'image-mode) (setq image-transform-resize image-auto-resize) - (setq-local disable-point-adjustment t) ;; Bail out early if we have no image data. (if (zerop (buffer-size)) @@ -932,7 +931,6 @@ If the current buffer is displaying an image file as an image, call `image-mode-as-text' to switch to text or hex display. Otherwise, display the image by calling `image-mode'." (interactive) - (goto-char (point-min)) (if (image-get-display-property) (image-mode-as-text) (if (eq major-mode 'hexl-mode) From 1abf3ae854dbf8405e81680225517bbfac648964 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 14 Feb 2021 16:58:06 +0000 Subject: [PATCH 235/297] Pacify unused function warning in xfns.c with GTK2 * src/xfns.c (x_get_net_workarea, x_get_monitor_for_frame) (x_make_monitor_attribute_list, x_get_monitor_attributes_fallback): [HAVE_XINERAMA] (x_get_monitor_attributes_xinerama) [HAVE_XRANDR] (x_get_monitor_attributes_xrandr) (x_get_monitor_attributes): Fix #ifdefs around definitions to avoid unused function warnings regardless of GTK use (bug#46509). [HAVE_XRANDR] (x_get_monitor_attributes_xrandr): Undefine RANDR13_LIBRARY after it's been used. --- src/xfns.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/xfns.c b/src/xfns.c index 481ee0e2255..d90644819b6 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4599,7 +4599,7 @@ On MS Windows, this just returns nil. */) return Qnil; } -#if !defined USE_GTK || !defined HAVE_GTK3 +#if !(defined USE_GTK && defined HAVE_GTK3) /* Store the geometry of the workarea on display DPYINFO into *RECT. Return false if and only if the workarea information cannot be @@ -4662,6 +4662,9 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) return result; } +#endif /* !(USE_GTK && HAVE_GTK3) */ + +#ifndef USE_GTK /* Return monitor number where F is "most" or closest to. */ static int @@ -4877,6 +4880,8 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo) pxid = XRRGetOutputPrimary (dpy, dpyinfo->root_window); #endif +#undef RANDR13_LIBRARY + for (i = 0; i < n_monitors; ++i) { XRROutputInfo *info = XRRGetOutputInfo (dpy, resources, From 12b80948fd2fc599b9ea4cc6497c007205b3e57e Mon Sep 17 00:00:00 2001 From: Bastian Beranek Date: Tue, 16 Feb 2021 11:35:35 +0100 Subject: [PATCH 236/297] * lisp/tab-bar.el: Fix behavior of toggle-frame-tab-bar (bug #46299) (toggle-frame-tab-bar): Add frame parameter to protect tab bar state. (tab-bar--update-tab-bar-lines): Check parameter. --- lisp/tab-bar.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 4e47ae2c10e..f0210e1a42b 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -161,7 +161,8 @@ update." (t frames)))) ;; Loop over all frames and update default-frame-alist (dolist (frame frame-lst) - (set-frame-parameter frame 'tab-bar-lines (tab-bar--tab-bar-lines-for-frame frame)))) + (unless (frame-parameter frame 'tab-bar-lines-keep-state) + (set-frame-parameter frame 'tab-bar-lines (tab-bar--tab-bar-lines-for-frame frame))))) (when (eq frames t) (setq default-frame-alist (cons (cons 'tab-bar-lines (if (and tab-bar-mode (eq tab-bar-show t)) 1 0)) @@ -233,7 +234,9 @@ new frame when the global `tab-bar-mode' is enabled, by using (add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)" (interactive) (set-frame-parameter frame 'tab-bar-lines - (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1))) + (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)) + (set-frame-parameter frame 'tab-bar-lines-keep-state + (not (frame-parameter frame 'tab-bar-lines-keep-state)))) (defvar tab-bar-map (make-sparse-keymap) "Keymap for the tab bar. From f2bf357308dc35e311f1b77e03f4c68b071f5acc Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 16 Feb 2021 12:01:25 -0800 Subject: [PATCH 237/297] * admin/cus-test.el (cus-test-get-lisp-files): Ignore loaddefs files. --- admin/cus-test.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/admin/cus-test.el b/admin/cus-test.el index 995586f9c71..7938359119d 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -349,6 +349,8 @@ Optional argument ALL non-nil means list all (non-obsolete) Lisp files." (mapcar (lambda (e) (substring e 2)) (apply #'process-lines find-program "." "-name" "obsolete" "-prune" "-o" + "-name" "ldefs-boot.el" "-prune" "-o" + "-name" "*loaddefs.el" "-prune" "-o" "-name" "[^.]*.el" ; ignore .dir-locals.el (if all '("-print") From b2fe1bbd06b6654427d9ff07124be02a21e54c3b Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 16 Feb 2021 12:03:39 -0800 Subject: [PATCH 238/297] * admin/cus-test.el (cus-test-load-libs): Quieten loading. --- admin/cus-test.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/admin/cus-test.el b/admin/cus-test.el index 7938359119d..afd5f4ceaec 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -320,7 +320,8 @@ If it is \"all\", load all Lisp files." (lambda (file) (condition-case alpha (unless (member file cus-test-libs-noloads) - (load (file-name-sans-extension (expand-file-name file lispdir))) + (load (file-name-sans-extension (expand-file-name file lispdir)) + nil t) (push file cus-test-libs-loaded)) (error (push (cons file alpha) cus-test-libs-errors) From bdb0774faf250798d043a93e8a7295df924c4c3b Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 16 Feb 2021 12:11:55 -0800 Subject: [PATCH 239/297] thumbs.el: avoid creating thumbs directory on loading library * lisp/thumbs.el (thumbs-cleanup-thumbsdir): Don't create the thumbs directory if it does not exist. --- lisp/thumbs.el | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 465d097b615..957940bfe0c 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -199,23 +199,24 @@ Create the thumbnails directory if it does not exist." If the total size of all files in `thumbs-thumbsdir' is bigger than `thumbs-thumbsdir-max-size', files are deleted until the max size is reached." - (let* ((files-list - (sort - (mapcar - (lambda (f) - (let ((fattribs-list (file-attributes f))) - `(,(file-attribute-access-time fattribs-list) - ,(file-attribute-size fattribs-list) - ,f))) - (directory-files (thumbs-thumbsdir) t (image-file-name-regexp))) - (lambda (l1 l2) (time-less-p (car l1) (car l2))))) - (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list)))) - (while (> dirsize thumbs-thumbsdir-max-size) - (progn - (message "Deleting file %s" (cadr (cdar files-list)))) - (delete-file (cadr (cdar files-list))) - (setq dirsize (- dirsize (car (cdar files-list)))) - (setq files-list (cdr files-list))))) + (when (file-directory-p thumbs-thumbsdir) + (let* ((files-list + (sort + (mapcar + (lambda (f) + (let ((fattribs-list (file-attributes f))) + `(,(file-attribute-access-time fattribs-list) + ,(file-attribute-size fattribs-list) + ,f))) + (directory-files (thumbs-thumbsdir) t (image-file-name-regexp))) + (lambda (l1 l2) (time-less-p (car l1) (car l2))))) + (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list)))) + (while (> dirsize thumbs-thumbsdir-max-size) + (progn + (message "Deleting file %s" (cadr (cdar files-list)))) + (delete-file (cadr (cdar files-list))) + (setq dirsize (- dirsize (car (cdar files-list)))) + (setq files-list (cdr files-list)))))) ;; Check the thumbnail directory size and clean it if necessary. (when thumbs-thumbsdir-auto-clean From cead0ea38e3e15a544f7374b2e831623bda37f1d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Feb 2021 23:06:46 +0100 Subject: [PATCH 240/297] Clarify Gnus Agent expiry quirks * doc/misc/gnus.texi (Agent Expiry): Mention that the last article won't be expired (bug#46533). --- doc/misc/gnus.texi | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 5a79cbc08fc..fef066db8fd 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -19357,6 +19357,9 @@ and dormant. If @code{nil} (which is the default), only read articles are eligible for expiry, and unread, ticked and dormant articles will be kept indefinitely. +The last (i.e., newest) article in a group will normally not be +expired (due to internal book-keeping reasons). + If you find that some articles eligible for expiry are never expired, perhaps some Gnus Agent files are corrupted. There's are special commands, @code{gnus-agent-regenerate} and From b39ac4c85a80bc2ee07c3e2f5d5b93c493062ecf Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Feb 2021 23:32:04 +0100 Subject: [PATCH 241/297] Fix edebug spec for minibuffer-with-setup-hook * lisp/files.el (minibuffer-with-setup-hook): Instrument the :append form for edebug (bug#46531). --- lisp/files.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index 9ff8f31e374..68e883513cb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1639,7 +1639,7 @@ called additional times). This macro actually adds an auxiliary function that calls FUN, rather than FUN itself, to `minibuffer-setup-hook'." - (declare (indent 1) (debug t)) + (declare (indent 1) (debug ([&or (":append" form) [&or symbolp form]] body))) (let ((hook (make-symbol "setup-hook")) (funsym (make-symbol "fun")) (append nil)) From 64ef8ff74d3f111d2d71a22c2326fa4c974182ba Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 00:43:52 +0100 Subject: [PATCH 242/297] Don't move point in `exif-parse-buffer' * lisp/image/exif.el (exif-parse-buffer): Don't move point (bug#46552). --- lisp/image/exif.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/image/exif.el b/lisp/image/exif.el index 2dc9419b817..c2cf2346408 100644 --- a/lisp/image/exif.el +++ b/lisp/image/exif.el @@ -118,8 +118,9 @@ If the data is invalid, an `exif-error' is signaled." dest)) (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) (exif--parse-exif-chunk app1)))) - (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) - (exif--parse-exif-chunk app1))))) + (save-excursion + (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) + (exif--parse-exif-chunk app1)))))) (defun exif-orientation (exif) "Return the orientation (in degrees) in EXIF. From 7b2448ae6eaf4ae5f81f1a1b1b9f1b14735e90d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Wed, 17 Feb 2021 00:54:38 +0100 Subject: [PATCH 243/297] cperl-mode: Improve detection of index entries for imenu * lisp/progmodes/cperl-mode.el (cperl-imenu-addback): Customization variable deleted. This variable has been declared obsolete in 1998. (cperl--basic-identifier-regexp) and many other variables: defining regular expressions for basic Perl constructs. (cperl-imenu--create-perl-index): This function has been completely rewritten, keeping only some parts of the output formatting. It now recognizes a lot more package and subroutine declarations which came since Perl 5.14: Packages with a version and/or a block attached, lexical subroutines, declarations with a newline between the keyword "package" and the package name, and several more. This version also correctly separates subroutine names from attributes, does no longer support "unnamed" packages (which don't exist in Perl), and doesn't fall for false positives like stuff that looks like a declaration in a multiline string. (cperl-tags-hier-init): Eliminate call to `cperl-imenu-addback` (which actually was commented out in 1997) * test/lisp/progmodes/cperl-mode-tests.el (cperl-test--validate-regexp) and six other new tests for the new regular expressions and the index creation. * test/lisp/progmodes/cperl-mode-resources/grammar.pl: New file showcasing different syntax variations for package and sub declarations (bug#46574). --- lisp/progmodes/cperl-mode.el | 360 +++++++++++------- .../progmodes/cperl-mode-resources/grammar.pl | 158 ++++++++ test/lisp/progmodes/cperl-mode-tests.el | 95 +++++ 3 files changed, 484 insertions(+), 129 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/grammar.pl diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 0dffe279c39..44a75269524 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -440,12 +440,6 @@ after reload." :type 'boolean :group 'cperl-speed) -(defcustom cperl-imenu-addback nil - "Not-nil means add backreferences to generated `imenu's. -May require patched `imenu' and `imenu-go'. Obsolete." - :type 'boolean - :group 'cperl-help-system) - (defcustom cperl-max-help-size 66 "Non-nil means shrink-wrapping of info-buffer allowed up to these percents." :type '(choice integer (const nil)) @@ -1216,6 +1210,153 @@ versions of Emacs." The expansion is entirely correct because it uses the C preprocessor." t) + +;;; Perl Grammar Components +;; +;; The following regular expressions are building blocks for a +;; minimalistic Perl grammar, to be used instead of individual (and +;; not always consistent) literal regular expressions. + +(defconst cperl--basic-identifier-regexp + (rx (sequence (or alpha "_") (* (or word "_")))) + "A regular expression for the name of a \"basic\" Perl variable. +Neither namespace separators nor sigils are included. As is, +this regular expression applies to labels,subroutine calls where +the ampersand sigil is not required, and names of subroutine +attributes.") + +(defconst cperl--label-regexp + (rx-to-string + `(sequence + symbol-start + (regexp ,cperl--basic-identifier-regexp) + (0+ space) + ":")) + "A regular expression for a Perl label. +By convention, labels are uppercase alphabetics, but this isn't +enforced.") + +(defconst cperl--normal-identifier-regexp + (rx-to-string + `(or + (sequence + (1+ (sequence + (opt (regexp ,cperl--basic-identifier-regexp)) + "::")) + (opt (regexp ,cperl--basic-identifier-regexp))) + (regexp ,cperl--basic-identifier-regexp))) + "A regular expression for a Perl variable name with optional namespace. +Examples are `foo`, `Some::Module::VERSION`, and `::` (yes, that +is a legal variable name).") + +(defconst cperl--special-identifier-regexp + (rx-to-string + `(or + (1+ digit) ; $0, $1, $2, ... + (sequence "^" (any "A-Z" "]^_?\\")) ; $^V + (sequence "{" (0+ space) ; ${^MATCH} + "^" (any "A-Z" "]^_?\\") + (0+ (any "A-Z" "_" digit)) + (0+ space) "}") + (in "!\"$%&'()+,-./:;<=>?@\\]^_`|~"))) ; $., $|, $", ... but not $^ or ${ + "The list of Perl \"punctuation\" variables, as listed in perlvar.") + +(defconst cperl--ws-regexp + (rx-to-string + '(or space "\n")) + "Regular expression for a single whitespace in Perl.") + +(defconst cperl--eol-comment-regexp + (rx-to-string + '(sequence "#" (0+ (not (in "\n"))) "\n")) + "Regular expression for a single end-of-line comment in Perl") + +(defconst cperl--ws-or-comment-regexp + (rx-to-string + `(1+ + (or + (regexp ,cperl--ws-regexp) + (regexp ,cperl--eol-comment-regexp)))) + "Regular expression for a sequence of whitespace and comments in Perl.") + +(defconst cperl--ows-regexp + (rx-to-string + `(opt (regexp ,cperl--ws-or-comment-regexp))) + "Regular expression for optional whitespaces or comments in Perl") + +(defconst cperl--version-regexp + (rx-to-string + `(or + (sequence (opt "v") + (>= 2 (sequence (1+ digit) ".")) + (1+ digit) + (opt (sequence "_" (1+ word)))) + (sequence (1+ digit) + (opt (sequence "." (1+ digit))) + (opt (sequence "_" (1+ word)))))) + "A sequence for recommended version number schemes in Perl.") + +(defconst cperl--package-regexp + (rx-to-string + `(sequence + "package" ; FIXME: the "class" and "role" keywords need to be + ; recognized soon...ish. + (regexp ,cperl--ws-or-comment-regexp) + (group (regexp ,cperl--normal-identifier-regexp)) + (opt + (sequence + (1+ (regexp ,cperl--ws-or-comment-regexp)) + (group (regexp ,cperl--version-regexp)))))) + "A regular expression for package NAME VERSION in Perl. +Contains two groups for the package name and version.") + +(defconst cperl--package-for-imenu-regexp + (rx-to-string + `(sequence + (regexp ,cperl--package-regexp) + (regexp ,cperl--ows-regexp) + (group (or ";" "{")))) + "A regular expression to collect package names for `imenu`. +Catches \"package NAME;\", \"package NAME VERSION;\", \"package +NAME BLOCK\" and \"package NAME VERSION BLOCK.\" Contains three +groups: Two from `cperl--package-regexp` for the package name and +version, and a third to detect \"package BLOCK\" syntax.") + +(defconst cperl--sub-name-regexp + (rx-to-string + `(sequence + (optional (sequence (group (or "my" "state" "our")) + (regexp ,cperl--ws-or-comment-regexp))) + "sub" ; FIXME: the "method" and maybe "fun" keywords need to be + ; recognized soon...ish. + (regexp ,cperl--ws-or-comment-regexp) + (group (regexp ,cperl--normal-identifier-regexp)))) + "A regular expression to detect a subroutine start. +Contains two groups: One for to distinguish lexical from +\"normal\" subroutines and one for the subroutine name.") + +(defconst cperl--pod-heading-regexp + (rx-to-string + `(sequence + line-start "=head" + (group (in "1-4")) + (1+ (in " \t")) + (group (1+ (not (in "\n")))) + line-end)) ; that line-end seems to be redundant? + "A regular expression to detect a POD heading. +Contains two groups: One for the heading level, and one for the +heading text.") + +(defconst cperl--imenu-entries-regexp + (rx-to-string + `(or + (regexp ,cperl--package-for-imenu-regexp) ; 1..3 + (regexp ,cperl--sub-name-regexp) ; 4..5 + (regexp ,cperl--pod-heading-regexp))) ; 6..7 + "A regular expression to collect stuff that goes into the `imenu` index. +Covers packages, subroutines, and POD headings.") + + ;; These two must be unwound, otherwise take exponential time (defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*" "Regular expression to match optional whitespace with interspersed comments. @@ -1227,8 +1368,7 @@ Should contain exactly one group.") Should contain exactly one group.") -;; Is incorporated in `cperl-imenu--function-name-regexp-perl' -;; `cperl-outline-regexp', `defun-prompt-regexp'. +;; Is incorporated in `cperl-outline-regexp', `defun-prompt-regexp'. ;; Details of groups in this may be used in several functions; see comments ;; near mentioned above variable(s)... ;; sub($$):lvalue{} sub:lvalue{} Both allowed... @@ -5147,117 +5287,80 @@ indentation and initial hashes. Behaves usually outside of comment." ;; Previous space could have gone: (or (memq (preceding-char) '(?\s ?\t)) (insert " ")))))) -(defun cperl-imenu-addback (lst &optional isback name) - ;; We suppose that the lst is a DAG, unless the first element only - ;; loops back, and ISBACK is set. Thus this function cannot be - ;; applied twice without ISBACK set. - (cond ((not cperl-imenu-addback) lst) - (t - (or name - (setq name "+++BACK+++")) - (mapc (lambda (elt) - (if (and (listp elt) (listp (cdr elt))) - (progn - ;; In the other order it goes up - ;; one level only ;-( - (setcdr elt (cons (cons name lst) - (cdr elt))) - (cperl-imenu-addback (cdr elt) t name)))) - (if isback (cdr lst) lst)) - lst))) - -(defun cperl-imenu--create-perl-index (&optional regexp) - (require 'imenu) ; May be called from TAGS creator - (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) +(defun cperl-imenu--create-perl-index () + "Implement `imenu-create-index-function` for CPerl mode. +This function relies on syntaxification to exclude lines which +look like declarations but actually are part of a string, a +comment, or POD." + (interactive) ; We'll remove that at some point + (goto-char (point-min)) + (cperl-update-syntaxification (point-max)) + (let ((case-fold-search nil) + (index-alist '()) + (index-package-alist '()) + (index-pod-alist '()) + (index-sub-alist '()) (index-unsorted-alist '()) - (index-meth-alist '()) meth - packages ends-ranges p marker is-proto - is-pack index index1 name (end-range 0) package) - (goto-char (point-min)) - (cperl-update-syntaxification (point-max)) - ;; Search for the function - (progn ;;save-match-data - (while (re-search-forward - (or regexp cperl-imenu--function-name-regexp-perl) - nil t) - ;; 2=package-group, 5=package-name 8=sub-name + (package-stack '()) ; for package NAME BLOCK + (current-package "(main)") + (current-package-end (point-max))) ; end of package scope + ;; collect index entries + (while (re-search-forward cperl--imenu-entries-regexp nil t) + ;; First, check whether we have left the scope of previously + ;; recorded packages, and if so, eliminate them from the stack. + (while (< current-package-end (point)) + (setq current-package (pop package-stack)) + (setq current-package-end (pop package-stack))) + (let ((state (syntax-ppss)) + name marker) ; for the "current" entry (cond - ((and ; Skip some noise if building tags - (match-beginning 5) ; package name - ;;(eq (char-after (match-beginning 2)) ?p) ; package - (not (save-match-data - (looking-at "[ \t\n]*;")))) ; Plain text word 'package' - nil) - ((and - (or (match-beginning 2) - (match-beginning 8)) ; package or sub - ;; Skip if quoted (will not skip multi-line ''-strings :-(): - (null (get-text-property (match-beginning 1) 'syntax-table)) - (null (get-text-property (match-beginning 1) 'syntax-type)) - (null (get-text-property (match-beginning 1) 'in-pod))) - (setq is-pack (match-beginning 2)) - ;; (if (looking-at "([^()]*)[ \t\n\f]*") - ;; (goto-char (match-end 0))) ; Messes what follows - (setq meth nil - p (point)) - (while (and ends-ranges (>= p (car ends-ranges))) - ;; delete obsolete entries - (setq ends-ranges (cdr ends-ranges) packages (cdr packages))) - (setq package (or (car packages) "") - end-range (or (car ends-ranges) 0)) - (if is-pack ; doing "package" - (progn - (if (match-beginning 5) ; named package - (setq name (buffer-substring (match-beginning 5) - (match-end 5)) - name (progn - (set-text-properties 0 (length name) nil name) - name) - package (concat name "::") - name (concat "package " name)) - ;; Support nameless packages - (setq name "package;" package "")) - (setq end-range - (save-excursion - (parse-partial-sexp (point) (point-max) -1) (point)) - ends-ranges (cons end-range ends-ranges) - packages (cons package packages))) - (setq is-proto - (or (eq (following-char) ?\;) - (eq 0 (get-text-property (point) 'attrib-group))))) - ;; Skip this function name if it is a prototype declaration. - (if (and is-proto (not is-pack)) nil - (or is-pack - (setq name - (buffer-substring (match-beginning 8) (match-end 8))) - (set-text-properties 0 (length name) nil name)) - (setq marker (make-marker)) - (set-marker marker (match-end (if is-pack 2 8))) - (cond (is-pack nil) - ((string-match "[:']" name) - (setq meth t)) - ((> p end-range) nil) - (t - (setq name (concat package name) meth t))) - (setq index (cons name marker)) - (if is-pack - (push index index-pack-alist) - (push index index-alist)) - (if meth (push index index-meth-alist)) - (push index index-unsorted-alist))) - ((match-beginning 16) ; POD section - (setq name (buffer-substring (match-beginning 17) (match-end 17)) - marker (make-marker)) - (set-marker marker (match-beginning 17)) - (set-text-properties 0 (length name) nil name) - (setq name (concat (make-string - (* 3 (- (char-after (match-beginning 16)) ?1)) - ?\ ) - name) - index (cons name marker)) - (setq index1 (cons (concat "=" name) (cdr index))) - (push index index-pod-alist) - (push index1 index-unsorted-alist))))) + ((nth 3 state) nil) ; matched in a string, so skip + ((match-string 1) ; found a package name! + (unless (nth 4 state) ; skip if in a comment + (setq name (match-string-no-properties 1) + marker (copy-marker (match-end 1))) + (if (string= (match-string 3) ";") + (setq current-package name) ; package NAME; + ;; No semicolon, therefore we have: package NAME BLOCK. + ;; Stash the current package, because we need to restore + ;; it after the end of BLOCK. + (push current-package-end package-stack) + (push current-package package-stack) + ;; record the current name and its scope + (setq current-package name) + (setq current-package-end (save-excursion + (goto-char (match-beginning 3)) + (forward-sexp) + (point))) + (push (cons name marker) index-package-alist) + (push (cons (concat "package " name) marker) index-unsorted-alist)))) + ((match-string 5) ; found a sub name! + (unless (nth 4 state) ; skip if in a comment + (setq name (match-string-no-properties 5) + marker (copy-marker (match-end 5))) + ;; Qualify the sub name with the package if it doesn't + ;; already have one, and if it isn't lexically scoped. + ;; "my" and "state" subs are lexically scoped, but "our" + ;; are just lexical aliases to package subs. + (if (and (null (string-match "::" name)) + (or (null (match-string 4)) + (string-equal (match-string 4) "our"))) + (setq name (concat current-package "::" name))) + (let ((index (cons name marker))) + (push index index-alist) + (push index index-sub-alist) + (push index index-unsorted-alist)))) + ((match-string 6) ; found a POD heading! + (when (get-text-property (match-beginning 6) 'in-pod) + (setq name (concat (make-string + (* 3 (- (char-after (match-beginning 6)) ?1)) + ?\ ) + (match-string-no-properties 7)) + marker (copy-marker (match-beginning 7))) + (push (cons name marker) index-pod-alist) + (push (cons (concat "=" name) marker) index-unsorted-alist))) + (t (error "Unidentified match: %s" (match-string 0)))))) + ;; Now format the collected stuff (setq index-alist (if (default-value 'imenu-sort-function) (sort index-alist (default-value 'imenu-sort-function)) @@ -5266,14 +5369,14 @@ indentation and initial hashes. Behaves usually outside of comment." (push (cons "+POD headers+..." (nreverse index-pod-alist)) index-alist)) - (and (or index-pack-alist index-meth-alist) - (let ((lst index-pack-alist) hier-list pack elt group name) - ;; Remove "package ", reverse and uniquify. + (and (or index-package-alist index-sub-alist) + (let ((lst index-package-alist) hier-list pack elt group name) + ;; reverse and uniquify. (while lst - (setq elt (car lst) lst (cdr lst) name (substring (car elt) 8)) + (setq elt (car lst) lst (cdr lst) name (car elt)) (if (assoc name hier-list) nil (setq hier-list (cons (cons name (cdr elt)) hier-list)))) - (setq lst index-meth-alist) + (setq lst index-sub-alist) (while lst (setq elt (car lst) lst (cdr lst)) (cond ((string-match "\\(::\\|'\\)[_a-zA-Z0-9]+$" (car elt)) @@ -5301,17 +5404,18 @@ indentation and initial hashes. Behaves usually outside of comment." (push (cons "+Hierarchy+..." hier-list) index-alist))) - (and index-pack-alist + (and index-package-alist (push (cons "+Packages+..." - (nreverse index-pack-alist)) + (nreverse index-package-alist)) index-alist)) - (and (or index-pack-alist index-pod-alist + (and (or index-package-alist index-pod-alist (default-value 'imenu-sort-function)) index-unsorted-alist (push (cons "+Unsorted List+..." (nreverse index-unsorted-alist)) index-alist)) - (cperl-imenu-addback index-alist))) + ;; Finally, return the whole collection + index-alist)) ;; Suggested by Mark A. Hershberger @@ -6631,9 +6735,7 @@ One may build such TAGS files from CPerl mode menu." (cperl-tags-treeify to 1) (setcar (nthcdr 2 cperl-hierarchy) (cperl-menu-to-keymap (cons '("+++UPDATE+++" . -999) (cdr to)))) - (message "Updating list of classes: done, requesting display...") - ;;(cperl-imenu-addback (nth 2 cperl-hierarchy)) - )) + (message "Updating list of classes: done, requesting display..."))) (or (nth 2 cperl-hierarchy) (error "No items found")) (setq update diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl new file mode 100644 index 00000000000..c05fd7efc2a --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl @@ -0,0 +1,158 @@ +use 5.024; +use strict; +use warnings; + +sub outside { + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}'"; +} + +package Package; + +=head1 NAME + +grammar - A Test resource for regular expressions + +=head1 SYNOPSIS + +A Perl file showing a variety of declarations + +=head1 DESCRIPTION + +This file offers several syntactical constructs for packages, +subroutines, and POD to test the imenu capabilities of CPerl mode. + +Perl offers syntactical variations for package and subroutine +declarations. Packages may, or may not, have a version and may, or +may not, have a block of code attached to them. Subroutines can have +old-style prototypes, attributes, and signatures which are still +experimental but widely accepted. + +Various Extensions and future Perl versions will probably add new +keywords for "class" and "method", both with syntactical extras of +their own. + +This test file tries to keep up with them. + +=head2 Details + +The code is supposed to identify and exclude false positives, +e.g. declarations in a string or in POD, as well as POD in a string. +These should not go into the imenu index. + +=cut + +our $VERSION = 3.1415; +say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + +sub in_package { + # Special test for POD: A line which looks like POD, but actually + # is part of a multiline string. In the case shown here, the + # semicolon is not part of the string, but POD headings go to the + # end of the line. The code needs to distinguish between a POD + # heading "This Is Not A Pod/;" and a multiline string. + my $not_a_pod = q/Another false positive: + +=head1 This Is Not A Pod/; + +} + +sub Shoved::elsewhere { + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', sub Shoved::elsewhere"; +} + +sub prototyped ($$) { + ...; +} + +package Versioned::Package 0.07; +say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + +sub versioned { + # This sub is in package Versioned::Package + say "sub 'versioned' in package '", __PACKAGE__, "'"; +} + +versioned(); + +my $false_positives = <<'EOH'; +The following declarations are not supposed to be recorded for imenu. +They are in a HERE-doc, which is a generic comment in CPerl mode. + +package Don::T::Report::This; +sub this_is_no_sub { + my $self = shuffle; +} + +And this is not a POD heading: + +=head1 Not a POD heading, just a string. + +EOH + +package Block { + our $VERSION = 2.7182; + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + + sub attr:lvalue { + say "sub 'attr' in package '", __PACKAGE__, "'"; + } + + attr(); + + package Block::Inner { + # This hopefully doesn't happen too often. + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + } + + # Now check that we're back to package "Block" + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; +} + +sub outer { + # This is in package Versioned::Package + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; +} + +outer(); + +package Versioned::Block 42 { + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + + my sub lexical { + say "sub 'lexical' in package '", __PACKAGE__, "'"; + } + + lexical(); + + use experimental 'signatures'; + sub signatured :prototype($@) ($self,@rest) + { + ...; + } +} + +# After all is said and done, we're back in package Versioned::Package. +say "We're in package '", __PACKAGE__, "' now."; +say "Now try to call a subroutine which went out of scope:"; +eval { lexical() }; +say $@ if $@; + +# Now back to Package. This must not appear separately in the +# hierarchy list. +package Package; + +our sub in_package_again { + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; +} + + +package :: { + # This is just a weird, but legal, package name. + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + + in_package_again(); # weird, but calls the sub from above +} + +Shoved::elsewhere(); + +1; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 943c454445c..61e4ece49b7 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -166,6 +166,101 @@ point in the distant past, and is still broken in perl-mode. " (if (match-beginning 3) 0 perl-indent-level))))))) +;;; Grammar based tests: unit tests + +(defun cperl-test--validate-regexp (regexp valid &optional invalid) + "Runs tests for elements of VALID and INVALID lists against REGEXP. +Tests with elements from VALID must match, tests with elements +from INVALID must not match. The match string must be equal to +the whole string." + (funcall cperl-test-mode) + (dolist (string valid) + (should (string-match regexp string)) + (should (string= (match-string 0 string) string))) + (when invalid + (dolist (string invalid) + (should-not + (and (string-match regexp string) + (string= (match-string 0 string) string)))))) + +(ert-deftest cperl-test-ws-regexp () + "Tests capture of very simple regular expressions (yawn)." + (let ((valid + '(" " "\t" "\n")) + (invalid + '("a" " " ""))) + (cperl-test--validate-regexp cperl--ws-regexp + valid invalid))) + +(ert-deftest cperl-test-ws-or-comment-regexp () + "Tests sequences of whitespace and comment lines." + (let ((valid + `(" " "\t#\n" "\n# \n" + ,(concat "# comment\n" "# comment\n" "\n" "#comment\n"))) + (invalid + '("=head1 NAME\n" ))) + (cperl-test--validate-regexp cperl--ws-or-comment-regexp + valid invalid))) + +(ert-deftest cperl-test-version-regexp () + "Tests the regexp for recommended syntax of versions in Perl." + (let ((valid + '("1" "1.1" "1.1_1" "5.032001" + "v120.100.103")) + (invalid + '("alpha" "0." ".123" "1E2" + "v1.1" ; a "v" version string needs at least 3 components + ;; bad examples from "Version numbers should be boring" + ;; by xdg AKA David A. Golden + "1.20alpha" "2.34beta2" "2.00R3"))) + (cperl-test--validate-regexp cperl--version-regexp + valid invalid))) + +(ert-deftest cperl-test-package-regexp () + "Tests the regular expression of Perl package names with versions. +Also includes valid cases with whitespace in strange places." + (let ((valid + '("package Foo" + "package Foo::Bar" + "package Foo::Bar v1.2.3" + "package Foo::Bar::Baz 1.1" + "package \nFoo::Bar\n 1.00")) + (invalid + '("package Foo;" ; semicolon must not be included + "package Foo 1.1 {" ; nor the opening brace + "packageFoo" ; not a package declaration + "package Foo1.1" ; invalid package name + "class O3D::Sphere"))) ; class not yet supported + (cperl-test--validate-regexp cperl--package-regexp + valid invalid))) + +;;; Function test: Building an index for imenu + +(ert-deftest cperl-test-imenu-index () + "Test index creation for imenu. +This test relies on the specific layout of the index alist as +created by CPerl mode, so skip it for Perl mode." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (with-temp-buffer + (insert-file (ert-resource-file "grammar.pl")) + (cperl-mode) + (let ((index (cperl-imenu--create-perl-index)) + current-list) + (setq current-list (assoc-string "+Unsorted List+..." index)) + (should current-list) + (let ((expected '("(main)::outside" + "Package::in_package" + "Shoved::elsewhere" + "Package::prototyped" + "Versioned::Package::versioned" + "Block::attr" + "Versioned::Package::outer" + "lexical" + "Versioned::Block::signatured" + "Package::in_package_again"))) + (dolist (sub expected) + (should (assoc-string sub index))))))) + ;;; Tests for issues reported in the Bug Tracker (defun cperl-test--run-bug-10483 () From 45e964755bafec934b34f5c7c65e861fbe4c8aa6 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 16 Feb 2021 20:34:26 -0800 Subject: [PATCH 244/297] Remove TIME_WITH_SYS_TIME, unused for a long time * configure.ac (AC_HEADER_TIME): Remove. (Bug#46578) --- admin/CPP-DEFINES | 1 - configure.ac | 1 - 2 files changed, 2 deletions(-) diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index a40b4302723..cb69b2c36c2 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -378,7 +378,6 @@ SYSTEM_MALLOC TAB3 TABDLY TERM -TIME_WITH_SYS_TIME TIOCSIGSEND TM_IN_SYS_TIME UNIX98_PTYS diff --git a/configure.ac b/configure.ac index 12cf36303b3..5fd0e76b823 100644 --- a/configure.ac +++ b/configure.ac @@ -1768,7 +1768,6 @@ fi dnl On Solaris 8 there's a compilation warning for term.h because dnl it doesn't define 'bool'. AC_CHECK_HEADERS(term.h, , , -) -AC_HEADER_TIME AC_HEADER_SYS_WAIT AC_CHECK_HEADERS_ONCE(sys/socket.h) From 5f078928bbe85c11d5240d178b3801cd2e23198e Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 16 Feb 2021 20:54:46 -0800 Subject: [PATCH 245/297] * configure.ac: Replace obsolete AC_TRY_LINK with AC_LINK_IFELSE. --- configure.ac | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/configure.ac b/configure.ac index 5fd0e76b823..9a294bc796f 100644 --- a/configure.ac +++ b/configure.ac @@ -4715,10 +4715,10 @@ if test "$USE_X_TOOLKIT" != "none"; then else OTHERLIBS="-lXt -$LIBXMU" fi - AC_TRY_LINK( - [#include - #include ], - [_XEditResCheckMessages (0, 0, 0, 0);], + AC_LINK_IFELSE([AC_LANG_PROGRAM( + [[#include + #include ]], + [[_XEditResCheckMessages (0, 0, 0, 0);]])], [AC_DEFINE([X_TOOLKIT_EDITRES], 1, [Define to 1 if we should use XEditRes.])]) LIBS=$OLDLIBS From 26fcd8289057805f506a24c6ae7277c653463208 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 16 Feb 2021 21:25:18 -0800 Subject: [PATCH 246/297] * configure.ac: Replace obsolete AC_CHECK_HEADER usage. (Bug#46578) --- configure.ac | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 9a294bc796f..11a06a39bee 100644 --- a/configure.ac +++ b/configure.ac @@ -1767,7 +1767,8 @@ fi dnl On Solaris 8 there's a compilation warning for term.h because dnl it doesn't define 'bool'. -AC_CHECK_HEADERS(term.h, , , -) +AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[#include ]],[[]])], + AC_DEFINE(HAVE_TERM_H, 1, [Define to 1 if you have the header file.])) AC_HEADER_SYS_WAIT AC_CHECK_HEADERS_ONCE(sys/socket.h) From b3e34643c41399239f4846c28221b678804e370b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 12:01:27 +0100 Subject: [PATCH 247/297] Change name for the completion-* predicates * lisp/simple.el (command-completion-default-include-p) (command-completion-with-modes-p, command-completion-button-p): Rename from completion-*. (read-extended-command-predicate): Adjust default predicate. * lisp/emacs-lisp/byte-run.el (byte-run--set-modes): Adjust predicate name. --- lisp/emacs-lisp/byte-run.el | 5 +++-- lisp/simple.el | 11 ++++++----- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 8a22388f1d7..76e7f01ace6 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -154,8 +154,9 @@ The return value of this function is not used." (defalias 'byte-run--set-modes #'(lambda (f _args &rest val) (list 'function-put (list 'quote f) - ''completion-predicate `(lambda (_ b) - (completion-with-modes-p ',val b))))) + ''completion-predicate + `(lambda (_ b) + (command-completion-with-modes-p ',val b))))) ;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist diff --git a/lisp/simple.el b/lisp/simple.el index 215f4399f4a..248d044b19c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1904,7 +1904,8 @@ to get different commands to edit and resubmit." (defvar extended-command-history nil) (defvar execute-extended-command--last-typed nil) -(defcustom read-extended-command-predicate #'completion-default-include-p +(defcustom read-extended-command-predicate + #'command-completion-default-include-p "Predicate to use to determine which commands to include when completing. The predicate function is called with two parameters: The symbol (i.e., command) in question that should be included or @@ -1912,7 +1913,7 @@ not, and the current buffer. The predicate should return non-nil if the command should be present when doing `M-x TAB'." :version "28.1" :type `(choice (const :tag "Exclude commands not relevant to the current mode" - completion-default-include-p) + command-completion-default-include-p) (const :tag "All commands" ,(lambda (_s _b) t)) (function :tag "Other function"))) @@ -1973,7 +1974,7 @@ This function uses the `read-extended-command-predicate' user option." (funcall read-extended-command-predicate sym buffer))) t nil 'extended-command-history)))) -(defun completion-default-include-p (symbol buffer) +(defun command-completion-default-include-p (symbol buffer) "Say whether SYMBOL should be offered as a completion. If there's a `completion-predicate' for SYMBOL, the result from calling that predicate is called. If there isn't one, this @@ -2002,7 +2003,7 @@ BUFFER." #'eq) (seq-intersection modes global-minor-modes #'eq)))))) -(defun completion-with-modes-p (modes buffer) +(defun command-completion-with-modes-p (modes buffer) "Say whether MODES are in action in BUFFER. This is the case if either the major mode is derived from one of MODES, or (if one of MODES is a minor mode), if it is switched on in BUFFER." @@ -2015,7 +2016,7 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER." #'eq) (seq-intersection modes global-minor-modes #'eq))) -(defun completion-button-p (category buffer) +(defun command-completion-button-p (category buffer) "Return non-nil if there's a button of CATEGORY at point in BUFFER." (with-current-buffer buffer (and (get-text-property (point) 'button) From 06f8407ee67b7b19302ff94e3d142c581ba1e25f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 12:15:07 +0100 Subject: [PATCH 248/297] Clarify 'read-extended-command-predicate' in NEWS --- etc/NEWS | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 943ad6ac591..b38865dd271 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -254,7 +254,9 @@ commands. The new keystrokes are 'C-x x g' ('revert-buffer'), +++ ** New user option 'read-extended-command-predicate'. This option controls how 'M-x TAB' performs completions. The default -predicate excludes modes for which the command is not applicable. +predicate excludes commands that are not applicable to the current +major and minor modes, and also respects the command's completion +predicate (if any). --- ** 'eval-expression' now no longer signals an error on incomplete expressions. From cccd701ac952f81da8444576a72d92b37ddf42d2 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 17 Feb 2021 13:27:56 +0000 Subject: [PATCH 249/297] ; Finish recent rename of completion-* predicates. --- lisp/net/shr.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 739b56b88c6..0e89999b756 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -434,7 +434,7 @@ Value is a pair of positions (START . END) if there is a non-nil (defun shr-show-alt-text () "Show the ALT text of the image under point." - (declare (completion (lambda (_ b) (completion-button-p 'shr b)))) + (declare (completion (lambda (_ b) (command-completion-button-p 'shr b)))) (interactive) (let ((text (get-text-property (point) 'shr-alt))) (if (not text) From 0324ec17375028bd1b26a6d695535450d5a5a9c5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 17:12:27 +0100 Subject: [PATCH 250/297] Fix recently introduced bug in `byte-compile-lambda' * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Fix recently introduced error when compiling non-lexical commands (bug#46589). --- lisp/emacs-lisp/bytecomp.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5c6b9c2e39a..9d80afd774f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2951,7 +2951,9 @@ for symbols generated by the byte compiler itself." ;; Skip (interactive) if it is in front (the most usual location). (if (eq int (car body)) (setq body (cdr body))) - (cond ((consp (cdr int)) + (cond ((consp (cdr int)) ; There is an `interactive' spec. + ;; Check that the bit after the `interactive' spec is + ;; just a list of symbols (i.e., modes). (unless (seq-every-p #'symbolp (cdr (cdr int))) (byte-compile-warn "malformed interactive specc: %s" (prin1-to-string int))) @@ -2966,16 +2968,14 @@ for symbols generated by the byte compiler itself." (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) - (setq int - (if (and (eq (car-safe form) 'list) - ;; For code using lexical-binding, form is not - ;; valid lisp, but rather an intermediate form - ;; which may include "calls" to - ;; internal-make-closure (Bug#29988). - (not lexical-binding)) - `(interactive ,form) - `(interactive ,newform))))) - ((cdr int) + (when (or (not (eq (car-safe form) 'list)) + ;; For code using lexical-binding, form is not + ;; valid lisp, but rather an intermediate form + ;; which may include "calls" to + ;; internal-make-closure (Bug#29988). + lexical-binding) + (setq int `(interactive ,newform))))) + ((cdr int) ; Invalid (interactive . something). (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))))) ;; Process the body. From 927b88571cebb4f64aca360fbfa5d15a1f922ad6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 17 Feb 2021 18:53:54 +0200 Subject: [PATCH 251/297] Disable filtering of commands in M-x completion This makes the default behavior like it was before: M-x completion doesn't filter out any commands. To have commands filtered based on their relevance to the current buffer's modes, customize the option 'read-extended-command-predicate' to call 'command-completion-default-include-p'. * doc/lispref/commands.texi (Interactive Call): * doc/emacs/m-x.texi (M-x): Update the description of 'read-extended-command-predicate' and improve wording. * etc/NEWS: Update the entry about 'read-extended-command-predicate'. * lisp/simple.el (read-extended-command-predicate): Change default value to nil. Update doc string. Add :group. (read-extended-command): Handle nil as meaning to apply no-filtering. --- doc/emacs/m-x.texi | 17 ++++++++++------- doc/lispref/commands.texi | 16 ++++++++++------ etc/NEWS | 8 +++++--- lisp/simple.el | 21 ++++++++++++--------- 4 files changed, 37 insertions(+), 25 deletions(-) diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi index 689125e7b4a..b8770982c5e 100644 --- a/doc/emacs/m-x.texi +++ b/doc/emacs/m-x.texi @@ -46,9 +46,17 @@ from running the command by name. @cindex obsolete command When @kbd{M-x} completes on commands, it ignores the commands that are declared @dfn{obsolete}; for these, you will have to type their -full name. Obsolete commands are those for which newer, better +full name. (Obsolete commands are those for which newer, better alternatives exist, and which are slated for removal in some future -Emacs release. +Emacs release.) + +@vindex read-extended-command-predicate + In addition, @kbd{M-x} completion can exclude commands that are not +relevant to, and generally cannot work with, the current buffer's +major mode (@pxref{Major Modes}) and minor modes (@pxref{Minor +Modes}). By default, no commands are excluded, but you can customize +the option @var{read-extended-command-predicate} to exclude those +irrelevant commands from completion results. To cancel the @kbd{M-x} and not run a command, type @kbd{C-g} instead of entering the command name. This takes you back to command level. @@ -94,8 +102,3 @@ the command is followed by arguments. @kbd{M-x} works by running the command @code{execute-extended-command}, which is responsible for reading the name of another command and invoking it. - -@vindex read-extended-command-predicate - This command heeds the @code{read-extended-command-predicate} -variable, which will (by default) filter out commands that are not -applicable to the current major mode (or enabled minor modes). diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index b3bcdf35c9f..cd30fb19ee2 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -776,12 +776,16 @@ part of the prompt. @vindex read-extended-command-predicate This command heeds the @code{read-extended-command-predicate} -variable, which will (by default) filter out commands that are not -applicable to the current major mode (or enabled minor modes). -@code{read-extended-command-predicate} will be called with two -parameters: The symbol that is to be included or not, and the current -buffer. If should return non-@code{nil} if the command is to be -included when completing. +variable, which can filter out commands that are not applicable to the +current major mode (or enabled minor modes). By default, the value of +this variable is @code{nil}, and no commands are filtered out. +However, customizing it to invoke the function +@code{command-completion-default-include-p} will perform +mode-dependent filtering. @code{read-extended-command-predicate} can +be any predicate function; it will be called with two parameters: the +command's symbol and the current buffer. If should return +non-@code{nil} if the command is to be included when completing in +that buffer. @end deffn @node Distinguish Interactive diff --git a/etc/NEWS b/etc/NEWS index b38865dd271..3bef7399fa8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -253,9 +253,11 @@ commands. The new keystrokes are 'C-x x g' ('revert-buffer'), +++ ** New user option 'read-extended-command-predicate'. -This option controls how 'M-x TAB' performs completions. The default -predicate excludes commands that are not applicable to the current -major and minor modes, and also respects the command's completion +This option controls how 'M-x' performs completion of commands when +you type TAB. By default, any command that matches what you have +typed is considered a completion candidate, but you can customize this +option to exclude commands that are not applicable to the current +buffer's major and minor modes, and respect the command's completion predicate (if any). --- diff --git a/lisp/simple.el b/lisp/simple.el index 248d044b19c..e54cbed7a76 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1904,17 +1904,18 @@ to get different commands to edit and resubmit." (defvar extended-command-history nil) (defvar execute-extended-command--last-typed nil) -(defcustom read-extended-command-predicate - #'command-completion-default-include-p +(defcustom read-extended-command-predicate nil "Predicate to use to determine which commands to include when completing. -The predicate function is called with two parameters: The -symbol (i.e., command) in question that should be included or -not, and the current buffer. The predicate should return non-nil -if the command should be present when doing `M-x TAB'." +If it's nil, include all the commands. +If it's a functoion, it will be called with two parameters: the +symbol of the command and a buffer. The predicate should return +non-nil if the command should be present when doing `M-x TAB' +in that buffer." :version "28.1" - :type `(choice (const :tag "Exclude commands not relevant to the current mode" + :group 'completion + :type `(choice (const :tag "Don't exclude any commands" nil) + (const :tag "Exclude commands irrelevant to current buffer's mode" command-completion-default-include-p) - (const :tag "All commands" ,(lambda (_s _b) t)) (function :tag "Other function"))) (defun read-extended-command () @@ -1971,7 +1972,9 @@ This function uses the `read-extended-command-predicate' user option." (complete-with-action action obarray string pred))) (lambda (sym) (and (commandp sym) - (funcall read-extended-command-predicate sym buffer))) + (or (null read-extended-command-predicate) + (and (functionp read-extended-command-predicate) + (funcall read-extended-command-predicate sym buffer))))) t nil 'extended-command-history)))) (defun command-completion-default-include-p (symbol buffer) From 0c30b939e7463d3d6d4021952e066ac6970e5081 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 17 Feb 2021 18:57:42 +0200 Subject: [PATCH 252/297] ; Fix last change in commands.texi. --- doc/lispref/commands.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index cd30fb19ee2..de04d89b8e2 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -775,6 +775,7 @@ part of the prompt. @end example @vindex read-extended-command-predicate +@findex command-completion-default-include-p This command heeds the @code{read-extended-command-predicate} variable, which can filter out commands that are not applicable to the current major mode (or enabled minor modes). By default, the value of From 199294206a3afb32674b93a2e2fab03d0f92c900 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 17 Feb 2021 18:59:01 +0200 Subject: [PATCH 253/297] ; Fix last m-x.texi change. --- doc/emacs/m-x.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi index b8770982c5e..c51f10a47aa 100644 --- a/doc/emacs/m-x.texi +++ b/doc/emacs/m-x.texi @@ -55,7 +55,7 @@ Emacs release.) relevant to, and generally cannot work with, the current buffer's major mode (@pxref{Major Modes}) and minor modes (@pxref{Minor Modes}). By default, no commands are excluded, but you can customize -the option @var{read-extended-command-predicate} to exclude those +the option @code{read-extended-command-predicate} to exclude those irrelevant commands from completion results. To cancel the @kbd{M-x} and not run a command, type @kbd{C-g} instead From e5f50f32f76bab2607d77f0dc51cf81ec0c1e232 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 17 Feb 2021 18:04:35 +0100 Subject: [PATCH 254/297] Further Tramp code cleanup * doc/misc/tramp.texi (Predefined connection information): Mention "about-args". * lisp/net/tramp-cmds.el (tramp-version): Adapt docstring. * lisp/net/tramp.el (tramp-handle-expand-file-name): * 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): Handle local "/..". * lisp/net/tramp-rclone.el (tramp-methods) : Adapt `tramp-mount-args'. (tramp-rclone-flush-directory-cache): Remove. (tramp-rclone-do-copy-or-rename-file) (tramp-rclone-handle-delete-directory) (tramp-rclone-handle-delete-file) (tramp-rclone-handle-make-directory): Don't use that function. (tramp-rclone-maybe-open-connection): Fix use of `tramp-mount-args'. * lisp/net/trampver.el (tramp-inside-emacs): New defun. * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process) (tramp-sh-handle-process-file, tramp-open-shell): Use it. (tramp-get-env-with-u-option): Remove. * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name-top): New test. --- doc/misc/tramp.texi | 6 ++- lisp/net/tramp-cmds.el | 2 +- lisp/net/tramp-gvfs.el | 3 ++ lisp/net/tramp-rclone.el | 71 ++++++------------------------------ lisp/net/tramp-sh.el | 39 +++++--------------- lisp/net/tramp-smb.el | 3 ++ lisp/net/tramp-sudoedit.el | 3 ++ lisp/net/tramp.el | 8 ++-- lisp/net/trampver.el | 5 +++ test/lisp/net/tramp-tests.el | 14 ++++++- 10 files changed, 57 insertions(+), 97 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index c2e9fe66dfd..6d602157344 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2083,10 +2083,12 @@ there is no effect of this property. @item @t{"mount-args"}@* @t{"copyto-args"}@* -@t{"moveto-args"} +@t{"moveto-args"}@* +@t{"about-args"} These properties keep optional flags to the different @option{rclone} -operations. Their default value is @code{nil}. +operations. See their default values in @code{tramp-methods} if you +want to change their values. @end itemize diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 097f25ea85e..f0bbe31cea0 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -465,7 +465,7 @@ For details, see `tramp-rename-files'." ;;;###tramp-autoload (defun tramp-version (arg) - "Print version number of tramp.el in minibuffer or current buffer." + "Print version number of tramp.el in echo area or current buffer." (interactive "P") (if arg (insert tramp-version) (message tramp-version))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e946d73e66c..9d4e04ca689 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1172,6 +1172,9 @@ file names." ;; There might be a double slash. 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 "/../"). (tramp-make-tramp-file-name diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 96f7d9a89b9..a7f4c9be82c 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -53,7 +53,12 @@ (tramp--with-startup (add-to-list 'tramp-methods `(,tramp-rclone-method - (tramp-mount-args nil) + ;; Be careful changing "--dir-cache-time", this could + ;; delay visibility of files. Since we use Tramp's + ;; internal cache for file attributes, there shouldn't + ;; be serious performance penalties when set to 0. + (tramp-mount-args + ("--no-unicode-normalization" "--dir-cache-time" "0s")) (tramp-copyto-args nil) (tramp-moveto-args nil) (tramp-about-args ("--full")))) @@ -247,24 +252,13 @@ file names." "Error %s `%s' `%s'" msg-operation filename newname))) (when (and t1 (eq op 'rename)) - (with-parsed-tramp-file-name filename v1 - (tramp-flush-file-properties v1 v1-localname) - (when (tramp-rclone-file-name-p filename) - (tramp-rclone-flush-directory-cache v1) - ;; The mount point's directory cache might need time - ;; to flush. - (while (file-exists-p filename) - (tramp-flush-file-properties v1 v1-localname))))) + (while (file-exists-p filename) + (with-parsed-tramp-file-name filename v1 + (tramp-flush-file-properties v1 v1-localname)))) (when t2 (with-parsed-tramp-file-name newname v2 - (tramp-flush-file-properties v2 v2-localname) - (when (tramp-rclone-file-name-p newname) - (tramp-rclone-flush-directory-cache v2) - ;; The mount point's directory cache might need time - ;; to flush. - (while (not (file-exists-p newname)) - (tramp-flush-file-properties v2 v2-localname)))))))))) + (tramp-flush-file-properties v2 v2-localname)))))))) (defun tramp-rclone-handle-copy-file (filename newname &optional ok-if-already-exists keep-date @@ -288,13 +282,11 @@ file names." "Like `delete-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name directory) nil (tramp-flush-directory-properties v localname) - (tramp-rclone-flush-directory-cache v) (delete-directory (tramp-rclone-local-file-name directory) recursive trash))) (defun tramp-rclone-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-rclone-flush-directory-cache v) (delete-file (tramp-rclone-local-file-name filename) trash) (tramp-flush-file-properties v localname))) @@ -420,8 +412,7 @@ file names." ;; whole file cache. (tramp-flush-file-properties v localname) (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))) - (tramp-rclone-flush-directory-cache v))) + v (if parents "/" (file-name-directory localname))))) (defun tramp-rclone-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -467,39 +458,6 @@ file names." mount) (match-string 1 mount))))))) -(defun tramp-rclone-flush-directory-cache (vec) - "Flush directory cache of VEC mount." - (let ((rclone-pid - ;; Identify rclone process. - (when (tramp-get-connection-process vec) - (with-tramp-connection-property - (tramp-get-connection-process vec) "rclone-pid" - (catch 'pid - (dolist - (pid - ;; Until Emacs 25, `process-attributes' could - ;; crash Emacs for some processes. So we use - ;; "pidof", which might not work everywhere. - (if (<= emacs-major-version 25) - (let ((default-directory - (tramp-compat-temporary-file-directory))) - (mapcar - #'string-to-number - (split-string - (shell-command-to-string "pidof rclone")))) - (list-system-processes))) - (and (string-match-p - (regexp-quote - (format "rclone mount %s:" (tramp-file-name-host vec))) - (or (cdr (assoc 'args (process-attributes pid))) "")) - (throw 'pid pid)))))))) - ;; Send a SIGHUP in order to flush directory cache. - (when rclone-pid - (tramp-message - vec 6 "Send SIGHUP %d: %s" - rclone-pid (cdr (assoc 'args (process-attributes rclone-pid)))) - (signal-process rclone-pid 'SIGHUP)))) - (defun tramp-rclone-local-file-name (filename) "Return local mount name of FILENAME." (setq filename (tramp-compat-file-name-unquote (expand-file-name filename))) @@ -572,7 +530,7 @@ connection if a previous connection has died for some reason." `("mount" ,(concat host ":/") ,(tramp-rclone-mount-point vec) ;; This could be nil. - ,(tramp-get-method-parameter vec 'tramp-mount-args)))) + ,@(tramp-get-method-parameter vec 'tramp-mount-args)))) (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc))) (tramp-cleanup-connection vec 'keep-debug 'keep-password)) @@ -607,9 +565,4 @@ The command is the list of strings ARGS." (provide 'tramp-rclone) -;;; TODO: - -;; * If possible, get rid of "rclone mount". Maybe it is more -;; performant then. - ;;; tramp-rclone.el ends here diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index bcdc014daba..57301994074 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2818,6 +2818,9 @@ the result will be a local, non-Tramp, file name." ;; 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 @@ -2927,16 +2930,11 @@ alternative implementation will be used." elt (default-toplevel-value 'process-environment)) (if (string-match-p "=" elt) (setq env (append env `(,elt))) - (if (tramp-get-env-with-u-option v) - (setq env (append `("-u" ,elt) env)) - (setq uenv (cons elt uenv))))))) + (setq uenv (cons elt uenv)))))) + (env (setenv-internal + env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) (command (when (stringp program) - (setenv-internal - env "INSIDE_EMACS" - (concat (or (getenv "INSIDE_EMACS") emacs-version) - ",tramp:" tramp-version) - 'keep) (format "cd %s && %s exec %s %s env %s %s" (tramp-shell-quote-argument localname) (if uenv @@ -3147,14 +3145,8 @@ alternative implementation will be used." (or (member elt (default-toplevel-value 'process-environment)) (if (string-match-p "=" elt) (setq env (append env `(,elt))) - (if (tramp-get-env-with-u-option v) - (setq env (append `("-u" ,elt) env)) - (setq uenv (cons elt uenv)))))) - (setenv-internal - env "INSIDE_EMACS" - (concat (or (getenv "INSIDE_EMACS") emacs-version) - ",tramp:" tramp-version) - 'keep) + (setq uenv (cons elt uenv))))) + (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep) (when env (setq command (format @@ -4307,10 +4299,9 @@ file exists and nonzero exit status otherwise." (tramp-send-command vec (format (concat - "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " + "exec env TERM='%s' INSIDE_EMACS='%s' " "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i") - tramp-terminal-type - (or (getenv "INSIDE_EMACS") emacs-version) tramp-version + tramp-terminal-type (tramp-inside-emacs) (or (getenv-internal "ENV" tramp-remote-process-environment) "") (if (stringp tramp-histfile-override) (format "HISTFILE=%s" @@ -5945,16 +5936,6 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." (tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile))) (delete-file tmpfile))))) -(defun tramp-get-env-with-u-option (vec) - "Check, whether the remote `env' command supports the -u option." - (with-tramp-connection-property vec "env-u-option" - (tramp-message vec 5 "Checking, whether `env -u' works") - ;; Option "-u" is a GNU extension. - (tramp-send-command-and-check - vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO" - (tramp-get-remote-null-device vec)) - t))) - ;; Some predefined connection properties. (defun tramp-get-inline-compress (vec prop size) "Return the compress command related to PROP. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 26ec910ecc8..4519c34d36e 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -743,6 +743,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Make the file name absolute. (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" 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 "/../"). (tramp-make-tramp-file-name diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 0a60b791822..e181365162e 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -364,6 +364,9 @@ the result will be a local, non-Tramp, file name." (when (string-equal uname "~") (setq uname (concat uname user))) (setq localname (concat uname fname)))) + ;; Do not keep "/..". + (when (string-match-p "^/\\.\\.?$" localname) + (setq localname "/")) ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../"). (tramp-make-tramp-file-name v (expand-file-name localname)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e33075ec6f5..e99e43938f2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3163,6 +3163,9 @@ User is always nil." (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) + ;; Do not keep "/..". + (when (string-match-p "^/\\.\\.?$" localname) + (setq localname "/")) ;; 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. @@ -3811,10 +3814,7 @@ It does not support `:stderr'." elt (default-toplevel-value 'process-environment)))) (setq env (cons elt env))))) (env (setenv-internal - env "INSIDE_EMACS" - (concat (or (getenv "INSIDE_EMACS") emacs-version) - ",tramp:" tramp-version) - 'keep)) + env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) (env (mapcar #'tramp-shell-quote-argument (delq nil env))) ;; Quote command. (command (mapconcat #'tramp-shell-quote-argument command " ")) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index ced3e93fc09..abd92219b27 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -80,6 +80,11 @@ (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) +(defun tramp-inside-emacs () + "Version string provided by INSIDE_EMACS enmvironment variable." + (concat (or (getenv "INSIDE_EMACS") emacs-version) + ",tramp:" tramp-version)) + ;; Tramp versions integrated into Emacs. If a user option declares a ;; `:package-version' which doesn't belong to an integrated Tramp ;; version, it must be added here as well (see `tramp-syntax', for diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index f4883923f6a..9a83fa66761 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2182,6 +2182,16 @@ is greater than 10. (expand-file-name ".." "./")) (concat (file-remote-p tramp-test-temporary-file-directory) "/")))) +(ert-deftest tramp-test05-expand-file-name-top () + "Check `expand-file-name'." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-ange-ftp-p))) + + (let ((dir (concat (file-remote-p tramp-test-temporary-file-directory) "/"))) + (dolist (local '("." "..")) + (should (string-equal (expand-file-name local dir) dir)) + (should (string-equal (expand-file-name (concat dir local)) dir))))) + (ert-deftest tramp-test06-directory-file-name () "Check `directory-file-name'. This checks also `file-name-as-directory', `file-name-directory', @@ -6730,8 +6740,8 @@ Since it unloads Tramp, it shall be the last test to run." If INTERACTIVE is non-nil, the tests are run interactively." (interactive "p") (funcall - (if interactive - #'ert-run-tests-interactively #'ert-run-tests-batch) "^tramp")) + (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch) + "^tramp")) ;; TODO: From 734396aa04cd57173f1a604397244ed84f3f56a8 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 17 Feb 2021 19:56:45 +0200 Subject: [PATCH 255/297] New command 'tab-duplicate' like in web browsers --- etc/NEWS | 3 +++ lisp/tab-bar.el | 9 +++++++++ 2 files changed, 12 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 3bef7399fa8..5c7acfdefaa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -471,6 +471,9 @@ value of 'tab-bar-show'. It can be used to enable/disable the tab bar individually on each frame independently from the value of 'tab-bar-mode' and 'tab-bar-show'. +--- +*** New command 'tab-duplicate'. + --- *** New user option 'tab-bar-tab-name-format-function'. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index f0210e1a42b..dba79fbd81c 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -897,6 +897,14 @@ If ARG is zero, create a new tab in place of the current tab." (tab-bar-new-tab-to (1+ to-index))) (tab-bar-new-tab-to))) +(defun tab-bar-duplicate-tab (&optional arg) + "Duplicate the current tab to ARG positions to the right. +If a negative ARG, duplicate the tab to ARG positions to the left. +If ARG is zero, duplicate the tab in place of the current tab." + (interactive "P") + (let ((tab-bar-new-tab-choice nil)) + (tab-bar-new-tab arg))) + (defvar tab-bar-closed-tabs nil "A list of closed tabs to be able to undo their closing.") @@ -1243,6 +1251,7 @@ and can restore them." (defalias 'tab-new 'tab-bar-new-tab) (defalias 'tab-new-to 'tab-bar-new-tab-to) +(defalias 'tab-duplicate 'tab-bar-duplicate-tab) (defalias 'tab-close 'tab-bar-close-tab) (defalias 'tab-close-other 'tab-bar-close-other-tabs) (defalias 'tab-undo 'tab-bar-undo-close-tab) From 12409c9064c386a496dcbdca76b790108f6c1cad Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 17 Feb 2021 20:04:42 +0200 Subject: [PATCH 256/297] New transient mode 'repeat-mode' to allow shorter key sequences (bug#46515) * doc/emacs/basic.texi (Repeating): Document repeat-mode. * lisp/repeat.el (repeat-exit-key): New defcustom. (repeat-mode): New global minor mode. (repeat-post-hook): New function. * lisp/bindings.el (undo-repeat-map): New variable. (undo): Put 'repeat-map' property with 'undo-repeat-map'. (next-error-repeat-map): New variable. (next-error, previous-error): Put 'repeat-map' property with 'next-error-repeat-map'. * lisp/window.el (other-window-repeat-map): New variable. (other-window): Put 'repeat-map' property with 'other-window-repeat-map'. (resize-window-repeat-map): New variable. (enlarge-window, enlarge-window-horizontally) (shrink-window-horizontally, shrink-window): Put 'repeat-map' property with 'resize-window-repeat-map'. --- doc/emacs/basic.texi | 11 +++++++ etc/NEWS | 11 +++++++ lisp/bindings.el | 17 +++++++++++ lisp/repeat.el | 71 ++++++++++++++++++++++++++++++++++++++++++++ lisp/window.el | 22 ++++++++++++++ 5 files changed, 132 insertions(+) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 444b28f24be..8bf52d5dd30 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -880,3 +880,14 @@ characters. You can repeat that command (including its argument) three additional times, to delete a total of 80 characters, by typing @kbd{C-x z z z}. The first @kbd{C-x z} repeats the command once, and each subsequent @kbd{z} repeats it once again. + +@findex repeat-mode + Also you can activate @code{repeat-mode} that temporarily enables +a transient mode with short keys after a limited number of commands. +Currently supported shorter key sequences are @kbd{C-x u u} instead of +@kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of +@kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^ +v v} to resize the selected window interactively, @kbd{M-g n n p p} to +navigate @code{next-error} matches. Any other key exits transient mode +and then is executed normally. The user option @code{repeat-exit-key} +defines an additional key to exit this transient mode. diff --git a/etc/NEWS b/etc/NEWS index 5c7acfdefaa..b96bcd9eccd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2068,6 +2068,17 @@ the behavior introduced in Octave 3.8 of using a backslash as a line continuation marker within double-quoted strings, and an ellipsis everywhere else. +** Repeat + ++++ +*** New transient mode 'repeat-mode' to allow shorter key sequences. +You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, +'C-x o o' instead of 'C-x o C-x o' to switch several windows, +'C-x { { } } ^ ^ v v' to resize the selected window interactively, +'M-g n n p p' to navigate next-error matches. Any other key exits +transient mode and then is executed normally. 'repeat-exit-key' +defines an additional key to exit mode like 'isearch-exit' (RET). + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index 2f4bab11cf5..7111ae6612c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -950,6 +950,12 @@ if `inhibit-field-text-motion' is non-nil." ;; Richard said that we should not use C-x and I have ;; no idea whereas to bind it. Any suggestion welcome. -stef ;; (define-key ctl-x-map "U" 'undo-only) +(defvar undo-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "u" 'undo) + map) + "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.") +(put 'undo 'repeat-map 'undo-repeat-map) (define-key esc-map "!" 'shell-command) (define-key esc-map "|" 'shell-command-on-region) @@ -1036,6 +1042,17 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "`" 'next-error) +(defvar next-error-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "n" 'next-error) + (define-key map "\M-n" 'next-error) + (define-key map "p" 'previous-error) + (define-key map "\M-p" 'previous-error) + map) + "Keymap to repeat next-error key sequences. Used in `repeat-mode'.") +(put 'next-error 'repeat-map 'next-error-repeat-map) +(put 'previous-error 'repeat-map 'next-error-repeat-map) + (defvar goto-map (make-sparse-keymap) "Keymap for navigation commands.") (define-key esc-map "g" goto-map) diff --git a/lisp/repeat.el b/lisp/repeat.el index 795577c93fc..84a613da0cf 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -329,6 +329,77 @@ recently executed command not bound to an input event\"." ;;;;; ************************* EMACS CONTROL ************************* ;;;;; + +;; And now for something completely different. + +;;; repeat-mode + +(defcustom repeat-exit-key nil + "Key that stops the modal repeating of keys in sequence. +For example, you can set it to like `isearch-exit'." + :type '(choice (const :tag "No special key to exit repeating sequence" nil) + (key-sequence :tag "Key that exits repeating sequence")) + :group 'convenience + :version "28.1") + +;;;###autoload +(define-minor-mode repeat-mode + "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." + :global t :group 'convenience + (if (not repeat-mode) + (remove-hook 'post-command-hook 'repeat-post-hook) + (add-hook 'post-command-hook 'repeat-post-hook) + (let* ((keymaps nil) + (commands (all-completions + "" obarray (lambda (s) + (and (commandp s) + (get s 'repeat-map) + (push (get s 'repeat-map) keymaps)))))) + (message "Repeat mode is enabled for %d commands and %d keymaps" + (length commands) + (length (delete-dups keymaps)))))) + +(defun repeat-post-hook () + "Function run after commands to set transient keymap for repeatable keys." + (when repeat-mode + (let ((repeat-map (and (symbolp this-command) + (get this-command 'repeat-map)))) + (when repeat-map + (when (boundp repeat-map) + (setq repeat-map (symbol-value repeat-map))) + (let ((map (copy-keymap repeat-map)) + keys mess) + (map-keymap (lambda (key _) (push key keys)) map) + + ;; Exit when the last char is not among repeatable keys, + ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. + (when (or (memq last-command-event keys) + (memq this-original-command '(universal-argument + universal-argument-more + digit-argument + negative-argument))) + ;; Messaging + (setq mess (format-message + "Repeat with %s%s" + (mapconcat (lambda (key) + (key-description (vector key))) + keys ", ") + (if repeat-exit-key + (format ", or exit with %s" + (key-description repeat-exit-key)) + ""))) + (if (current-message) + (message "%s [%s]" (current-message) mess) + (message mess)) + + ;; Adding an exit key + (when repeat-exit-key + (define-key map repeat-exit-key 'ignore)) + + (set-transient-map map))))))) + (provide 'repeat) ;;; repeat.el ends here diff --git a/lisp/window.el b/lisp/window.el index 2d0a73b426d..cfd9876ed05 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10252,6 +10252,28 @@ displaying that processes's buffer." (define-key ctl-x-4-map "1" 'same-window-prefix) (define-key ctl-x-4-map "4" 'other-window-prefix) +(defvar other-window-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "o" 'other-window) + map) + "Keymap to repeat other-window key sequences. Used in `repeat-mode'.") +(put 'other-window 'repeat-map 'other-window-repeat-map) + +(defvar resize-window-repeat-map + (let ((map (make-sparse-keymap))) + ;; Standard keys: + (define-key map "^" 'enlarge-window) + (define-key map "}" 'enlarge-window-horizontally) + (define-key map "{" 'shrink-window-horizontally) + ;; Additional keys: + (define-key map "v" 'shrink-window) + map) + "Keymap to repeat window resizing commands. Used in `repeat-mode'.") +(put 'enlarge-window 'repeat-map 'resize-window-repeat-map) +(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map) +(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) +(put 'shrink-window 'repeat-map 'resize-window-repeat-map) + (provide 'window) ;;; window.el ends here From 9afdf3abe32f5c61aa755faf0c068774d70ab791 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 19:25:08 +0100 Subject: [PATCH 257/297] Explicate on how to tag commands with modes * doc/lispref/commands.texi (Command Modes): New node. (Using Interactive): Move the `modes' text to the new node. --- doc/lispref/commands.texi | 88 ++++++++++++++++++++++++++++++++------- 1 file changed, 73 insertions(+), 15 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index de04d89b8e2..85376cc4598 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -144,6 +144,7 @@ commands by adding the @code{interactive} form to them. * Interactive Codes:: The standard letter-codes for reading arguments in various ways. * Interactive Examples:: Examples of how to read interactive arguments. +* Command Modes:: Specifying that commands are for a specific mode. * Generic Commands:: Select among command alternatives. @end menu @@ -178,21 +179,8 @@ occurs within the body, the form simply returns @code{nil} without even evaluating its argument. The @var{modes} list allows specifying which modes the command is -meant to be used in. This affects, for instance, completion in -@kbd{M-x} (commands won't be offered as completions if they don't -match (using @code{derived-mode-p}) the current major mode, or if the -mode is a minor mode, whether it's switched on in the current buffer). -This will also make @kbd{C-h m} list these commands (if they aren't -bound to any keys). - -For instance: - -@lisp -(interactive "p" dired-mode) -@end lisp - -This will mark the command as applicable for modes derived from -@code{dired-mode} only. +meant to be used in. See @ref{Command Modes} for more details about +the effect of specifying @var{modes}, and when to use it. By convention, you should put the @code{interactive} form in the function body, as the first top-level form. If there is an @@ -605,6 +593,76 @@ Put them into three windows, selecting the last one." @end group @end example +@node Command Modes +@subsection Specifying Modes For Commands + +Many commands in Emacs are general, and not tied to any specific mode. +For instance, @kbd{M-x kill-region} can be used pretty in pretty much +any mode that has editable text, and commands that display information +(like @kbd{M-x list-buffers}) can be used in pretty much any context. + +Many other commands, however, are specifically tied to a mode, and +make no sense outside of that context. For instance, @code{M-x +dired-diff} will just signal an error used outside of a dired buffer. + +Emacs therefore has a mechanism for specifying what mode (or modes) a +command ``belong'' to: + +@lisp +(defun dired-diff (...) + ... + (interactive "p" dired-mode) + ...) +@end lisp + +This will mark the command as applicable to @code{dired-mode} only (or +any modes that are derived from @code{dired-mode}). Any number of +modes can be added to the @code{interactive} form. + +@vindex read-extended-command-predicate +Specifying modes may affect completion in @kbd{M-x}, depending on the +value of @code{read-extended-command-predicate}. + +For instance, when using the +@code{command-completion-default-include-p} predicate, @kbd{M-x} won't +list commands that have been marked as being applicable to a specific +mode (unless you are in a buffer that uses that mode, of course). +This goes for both major and minor modes. + +Marking commands this way will also make @kbd{C-h m} list these +commands (if they aren't bound to any keys). + +If using this extended @code{interactive} form isn't convenient +(because the code is supposed to work in older versions of Emacs that +doesn't support the extended @code{interactive} form), the following +can be used instead: + +@lisp +(declare (modes dired-mode)) +@end lisp + +Which commands to tag with modes is to some degree a matter of taste, +but commands that clearly do not work outside of the mode should be +tagged. This includes commands that will signal an error if called +from somewhere else, but also commands that are destructive when +called from an unexpected mode. (This usually includes most of the +commands that are written for special (i.e., non-editing) modes.) + +Some commands may be harmless, and ``work'' when called from other +modes, but should still be tagged with a mode if they don't actually +make much sense to use elsewhere. For instance, many special modes +have commands to exit the buffer bound to @kbd{q}, and may not do +anything but issue a message like "Goodbye from this mode" and then +call @code{kill-buffer}. This command will ``work'' from any mode, +but it is highly unlikely that anybody would actually want to use the +command outside the context of this special mode. + +Many modes have a set of different commands that start that start the +mode in different ways, (e.g., @code{eww-open-in-new-buffer} and +@code{eww-open-file}). Commands like that should never be tagged as +mode-specific, as then can be issued by the user from pretty much any +context. + @node Generic Commands @subsection Select among Command Alternatives @cindex generic commands From a37b6d2cb45cc28953ff708a07ddcc7e34c40d72 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 17 Feb 2021 11:08:27 -0800 Subject: [PATCH 258/297] ; * admin/CPP-DEFINES: Remove unused defines. --- admin/CPP-DEFINES | 44 -------------------------------------------- 1 file changed, 44 deletions(-) diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index cb69b2c36c2..68c12438f5a 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -81,7 +81,6 @@ anymore, so they can be removed. AMPERSAND_FULL_NAME BROKEN_DATAGRAM_SOCKETS -BROKEN_FIONREAD BROKEN_GET_CURRENT_DIR_NAME BROKEN_PTY_READ_AFTER_EAGAIN DEFAULT_SOUND_DEVICE @@ -94,16 +93,12 @@ EMACS_CONFIG_OPTIONS EMACS_INT EMACS_UINT GC_MARK_SECONDARY_STACK -GC_MARK_STACK GC_SETJMP_WORKS GNU_MALLOC -HAVE_AIX_SMT_EXP -HAVE_ALARM HAVE_ALLOCA HAVE_ALLOCA_H HAVE_ALSA HAVE_BDFFONT -HAVE_BOXES HAVE_CFMAKERAW HAVE_CFSETSPEED HAVE_CLOCK_GETTIME @@ -117,7 +112,6 @@ HAVE_DBUS_VALIDATE_INTERFACE HAVE_DBUS_VALIDATE_MEMBER HAVE_DBUS_VALIDATE_PATH HAVE_DBUS_WATCH_GET_UNIX_FD -HAVE_DECL_GETENV HAVE_DECL_LOCALTIME_R HAVE_DECL_STRMODE HAVE_DECL_STRTOIMAX @@ -126,8 +120,6 @@ HAVE_DECL_STRTOULL HAVE_DECL_STRTOUMAX HAVE_DECL_TZNAME HAVE_DIALOGS -HAVE_DIFFTIME -HAVE_DUP2 HAVE_ENDGRENT HAVE_ENDPWENT HAVE_ENVIRON_DECL @@ -141,11 +133,9 @@ HAVE_FUTIMES HAVE_FUTIMESAT HAVE_GAI_STRERROR HAVE_GCONF -HAVE_GETDELIM HAVE_GETGRENT HAVE_GETHOSTNAME HAVE_GETIFADDRS -HAVE_GETLINE HAVE_GETLOADAVG HAVE_GETOPT_H HAVE_GETOPT_LONG_ONLY @@ -164,18 +154,8 @@ HAVE_GPM HAVE_GRANTPT HAVE_GSETTINGS HAVE_GTK3 -HAVE_GTK_ADJUSTMENT_GET_PAGE_SIZE -HAVE_GTK_DIALOG_GET_ACTION_AREA HAVE_GTK_FILE_SELECTION_NEW -HAVE_GTK_MAIN -HAVE_GTK_MULTIDISPLAY -HAVE_GTK_ORIENTABLE_SET_ORIENTATION -HAVE_GTK_WIDGET_GET_MAPPED -HAVE_GTK_WIDGET_GET_SENSITIVE -HAVE_GTK_WIDGET_GET_WINDOW -HAVE_GTK_WIDGET_SET_HAS_WINDOW HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP -HAVE_G_TYPE_INIT HAVE_IFADDRS_H HAVE_IMAGEMAGICK HAVE_INTTYPES_H @@ -193,10 +173,8 @@ HAVE_LIBLOCKFILE HAVE_LIBMAIL HAVE_LIBOTF HAVE_LIBPERFSTAT -HAVE_LIBPNG_PNG_H HAVE_LIBSELINUX HAVE_LIBXML2 -HAVE_LIBXMU HAVE_LOCALTIME_R HAVE_LOCAL_SOCKETS HAVE_LRAND48 @@ -209,24 +187,18 @@ HAVE_MAGICKEXPORTIMAGEPIXELS HAVE_MAGICKMERGEIMAGELAYERS HAVE_MAILLOCK_H HAVE_MALLOC_MALLOC_H -HAVE_MATHERR HAVE_MBSTATE_T -HAVE_MEMCMP -HAVE_MEMMOVE HAVE_MEMORY_H HAVE_MEMSET -HAVE_MENUS HAVE_MKSTEMP HAVE_MMAP HAVE_MULTILINGUAL_MENU -HAVE_NANOTIME HAVE_NET_IF_DL_H HAVE_NET_IF_H HAVE_NLIST_H HAVE_OTF_GET_VARIATION_GLYPHS HAVE_PERSONALITY_ADDR_NO_RANDOMIZE HAVE_PNG -HAVE_PNG_H HAVE_POSIX_MEMALIGN HAVE_PROCFS HAVE_PSELECT @@ -263,15 +235,12 @@ HAVE_SOUNDCARD_H HAVE_STDINT_H HAVE_STDIO_EXT_H HAVE_STDLIB_H -HAVE_STLIB_H_1 HAVE_STRINGS_H HAVE_STRING_H -HAVE_STRNCASECMP HAVE_STRSIGNAL HAVE_STRTOIMAX HAVE_STRTOLL HAVE_STRTOULL -HAVE_STRTOUMAX HAVE_STRUCT_ERA_ENTRY HAVE_STRUCT_IFREQ_IFR_ADDR HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN @@ -287,9 +256,7 @@ HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC -HAVE_STRUCT_TIMEZONE HAVE_STRUCT_TM_TM_ZONE -HAVE_STRUCT_UTIMBUF HAVE_ST_DM_MODE HAVE_SYMLINK HAVE_SYNC @@ -303,26 +270,20 @@ HAVE_SYS_SOCKET_H HAVE_SYS_SOUNDCARD_H HAVE_SYS_STAT_H HAVE_SYS_SYSTEMINFO_H -HAVE_SYS_TIMEB_H HAVE_SYS_TIME_H HAVE_SYS_TYPES_H HAVE_SYS_UN_H HAVE_SYS_UTSNAME_H HAVE_SYS_VLIMIT_H HAVE_SYS_WAIT_H -HAVE_TCATTR HAVE_TERM_H HAVE_TIFF -HAVE_TIMEVAL HAVE_TM_GMTOFF HAVE_TM_ZONE HAVE_TOUCHLOCK HAVE_TZNAME -HAVE_TZSET HAVE_UTIL_H HAVE_UTIMENSAT -HAVE_UTIMES -HAVE_UTIME_H HAVE_UTMP_H HAVE_VFORK HAVE_VFORK_H @@ -342,14 +303,10 @@ HAVE_XRMSETDATABASE HAVE_XSCREENNUMBEROFSCREEN HAVE_XSCREENRESOURCESTRING HAVE_X_I18N -HAVE_X_MENU HAVE_X_SM HAVE_X_WINDOWS -HAVE__BOOL -HAVE__FTIME HAVE___BUILTIN_UNWIND_INIT HAVE___EXECUTABLE_START -HAVE___FPENDING INTERNAL_TERMINAL IS_ANY_SEP IS_DIRECTORY_SEP @@ -359,7 +316,6 @@ MAIL_USE_POP MAIL_USE_SYSTEM_LOCK MAXPATHLEN NLIST_STRUCT -NO_EDITRES NSIG NSIG_MINIMUM NULL_DEVICE From da78d31c6ea61581242ad54ac5ca935faf48fd7a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 19:54:09 +0100 Subject: [PATCH 259/297] Mark up commands in buff-menu.el for modes --- lisp/buff-menu.el | 53 ++++++++++++++++++++++++----------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index bb39e1f5795..4022615a3b7 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -268,6 +268,7 @@ In Buffer Menu mode, the following commands are defined: \\[revert-buffer] Update the list of buffers. \\[Buffer-menu-toggle-files-only] Toggle whether the menu displays only file buffers. \\[Buffer-menu-bury] Bury the buffer listed on this line." + :interactive nil (setq-local buffer-stale-function (lambda (&optional _noconfirm) 'fast)) (add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t)) @@ -328,7 +329,7 @@ ARG, show only buffers that are visiting files." "Toggle whether the current buffer-menu displays only file buffers. With a positive ARG, display only file buffers. With zero or negative ARG, display other buffers as well." - (interactive "P") + (interactive "P" Buffer-menu-mode) (setq Buffer-menu-files-only (cond ((not arg) (not Buffer-menu-files-only)) ((> (prefix-numeric-value arg) 0) t))) @@ -373,14 +374,14 @@ is nil or omitted, and signal an error otherwise." (defun Buffer-menu-mark () "Mark the Buffer menu entry at point for later display. It will be displayed by the \\\\[Buffer-menu-select] command." - (interactive) + (interactive nil Buffer-menu-mode) (tabulated-list-set-col 0 (char-to-string Buffer-menu-marker-char) t) (forward-line)) (defun Buffer-menu-unmark (&optional backup) "Cancel all requested operations on buffer on this line and move down. Optional prefix arg means move up." - (interactive "P") + (interactive "P" Buffer-menu-mode) (Buffer-menu--unmark) (forward-line (if backup -1 1))) @@ -388,7 +389,7 @@ Optional prefix arg means move up." "Cancel a requested operation on all buffers. MARK is the character to flag the operation on the buffers. When called interactively prompt for MARK; RET remove all marks." - (interactive "cRemove marks (RET means all):") + (interactive "cRemove marks (RET means all):" Buffer-menu-mode) (save-excursion (goto-char (point-min)) (when (tabulated-list-header-overlay-p) @@ -403,12 +404,12 @@ When called interactively prompt for MARK; RET remove all marks." (defun Buffer-menu-unmark-all () "Cancel all requested operations on buffers." - (interactive) + (interactive nil Buffer-menu-mode) (Buffer-menu-unmark-all-buffers ?\r)) (defun Buffer-menu-backup-unmark () "Move up and cancel all requested operations on buffer on line above." - (interactive) + (interactive nil Buffer-menu-mode) (forward-line -1) (Buffer-menu--unmark)) @@ -427,7 +428,7 @@ will delete it. If prefix argument ARG is non-nil, it specifies the number of buffers to delete; a negative ARG means to delete backwards." - (interactive "p") + (interactive "p" Buffer-menu-mode) (if (or (null arg) (= arg 0)) (setq arg 1)) (while (> arg 0) @@ -446,14 +447,14 @@ buffers to delete; a negative ARG means to delete backwards." A subsequent \\`\\[Buffer-menu-execute]' command will delete the marked buffer. Prefix ARG means move that many lines." - (interactive "p") + (interactive "p" Buffer-menu-mode) (Buffer-menu-delete (- (or arg 1)))) (defun Buffer-menu-save () "Mark the buffer on this Buffer Menu line for saving. A subsequent \\`\\[Buffer-menu-execute]' command will save it." - (interactive) + (interactive nil Buffer-menu-mode) (when (Buffer-menu-buffer) (tabulated-list-set-col 2 "S" t) (forward-line 1))) @@ -462,7 +463,7 @@ will save it." "Mark the buffer on this line as unmodified (no changes to save). If ARG is non-nil (interactively, with a prefix argument), mark it as modified." - (interactive "P") + (interactive "P" Buffer-menu-mode) (with-current-buffer (Buffer-menu-buffer t) (set-buffer-modified-p arg)) (tabulated-list-set-col 2 (if arg "*" " ") t)) @@ -471,7 +472,7 @@ it as modified." "Save and/or delete marked buffers in the Buffer Menu. Buffers marked with \\`\\[Buffer-menu-save]' are saved. Buffers marked with \\`\\[Buffer-menu-delete]' are deleted." - (interactive) + (interactive nil Buffer-menu-mode) (save-excursion (Buffer-menu-beginning) (while (not (eobp)) @@ -502,7 +503,7 @@ You can mark buffers with the \\`\\[Buffer-menu-mark]' com This command deletes and replaces all the previously existing windows in the selected frame, and will remove any marks." - (interactive) + (interactive nil Buffer-menu-mode) (let* ((this-buffer (Buffer-menu-buffer t)) (menu-buffer (current-buffer)) (others (delq this-buffer (Buffer-menu-marked-buffers t))) @@ -533,23 +534,23 @@ If UNMARK is non-nil, unmark them." (defun Buffer-menu-isearch-buffers () "Search for a string through all marked buffers using Isearch." - (interactive) + (interactive nil Buffer-menu-mode) (multi-isearch-buffers (Buffer-menu-marked-buffers))) (defun Buffer-menu-isearch-buffers-regexp () "Search for a regexp through all marked buffers using Isearch." - (interactive) + (interactive nil Buffer-menu-mode) (multi-isearch-buffers-regexp (Buffer-menu-marked-buffers))) (defun Buffer-menu-multi-occur (regexp &optional nlines) "Show all lines in marked buffers containing a match for a regexp." - (interactive (occur-read-primary-args)) + (interactive (occur-read-primary-args) Buffer-menu-mode) (multi-occur (Buffer-menu-marked-buffers) regexp nlines)) (defun Buffer-menu-visit-tags-table () "Visit the tags table in the buffer on this line. See `visit-tags-table'." - (interactive) + (interactive nil Buffer-menu-mode) (let ((file (buffer-file-name (Buffer-menu-buffer t)))) (if file (visit-tags-table file) @@ -557,30 +558,30 @@ If UNMARK is non-nil, unmark them." (defun Buffer-menu-1-window () "Select this line's buffer, alone, in full frame." - (interactive) + (interactive nil Buffer-menu-mode) (switch-to-buffer (Buffer-menu-buffer t)) (bury-buffer (other-buffer)) (delete-other-windows)) (defun Buffer-menu-this-window () "Select this line's buffer in this window." - (interactive) + (interactive nil Buffer-menu-mode) (switch-to-buffer (Buffer-menu-buffer t))) (defun Buffer-menu-other-window () "Select this line's buffer in other window, leaving buffer menu visible." - (interactive) + (interactive nil Buffer-menu-mode) (switch-to-buffer-other-window (Buffer-menu-buffer t))) (defun Buffer-menu-switch-other-window () "Make the other window select this line's buffer. The current window remains selected." - (interactive) + (interactive nil Buffer-menu-mode) (display-buffer (Buffer-menu-buffer t) t)) (defun Buffer-menu-2-window () "Select this line's buffer, with previous buffer in second window." - (interactive) + (interactive nil Buffer-menu-mode) (let ((buff (Buffer-menu-buffer t)) (menu (current-buffer))) (delete-other-windows) @@ -591,7 +592,7 @@ The current window remains selected." (defun Buffer-menu-toggle-read-only () "Toggle read-only status of buffer on this line. This behaves like invoking \\[read-only-mode] in that buffer." - (interactive) + (interactive nil Buffer-menu-mode) (let ((read-only (with-current-buffer (Buffer-menu-buffer t) (read-only-mode 'toggle) @@ -600,7 +601,7 @@ This behaves like invoking \\[read-only-mode] in that buffer." (defun Buffer-menu-bury () "Bury the buffer listed on this line." - (interactive) + (interactive nil Buffer-menu-mode) (let ((buffer (tabulated-list-get-id))) (cond ((null buffer)) ((buffer-live-p buffer) @@ -616,12 +617,12 @@ This behaves like invoking \\[read-only-mode] in that buffer." (defun Buffer-menu-view () "View this line's buffer in View mode." - (interactive) + (interactive nil Buffer-menu-mode) (view-buffer (Buffer-menu-buffer t))) (defun Buffer-menu-view-other-window () "View this line's buffer in View mode in another window." - (interactive) + (interactive nil Buffer-menu-mode) (view-buffer-other-window (Buffer-menu-buffer t))) ;;; Functions for populating the Buffer Menu. @@ -646,7 +647,7 @@ means list those buffers and no others." (defun Buffer-menu-mouse-select (event) "Select the buffer whose line you click on." - (interactive "e") + (interactive "e" Buffer-menu-mode) (select-window (posn-window (event-end event))) (let ((buffer (tabulated-list-get-id (posn-point (event-end event))))) (when (buffer-live-p buffer) From a5293c8dd389f7bb873dc0a5556eb74d66b0d332 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 20:14:22 +0100 Subject: [PATCH 260/297] Make unused `Buffer-menu-sort' alias obsolete * lisp/buff-menu.el (Buffer-menu-sort): Make unused alias obsolete. * test/lisp/progmodes/elisp-mode-tests.el (find-defs-defalias-defun-el): Adjust test to use an alias that's not obsolete. --- lisp/buff-menu.el | 3 ++- test/lisp/progmodes/elisp-mode-tests.el | 19 +++++++++++-------- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 4022615a3b7..6df935fef8a 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -338,7 +338,8 @@ negative ARG, display other buffers as well." "Showing all non-internal buffers.")) (revert-buffer)) -(defalias 'Buffer-menu-sort 'tabulated-list-sort) +(define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort + "28.1") (defun Buffer-menu-buffer (&optional error-if-non-existent-p) diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index badcad670c2..f47d54e59c0 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -398,18 +398,21 @@ to (xref-elisp-test-descr-to-target xref)." "(cl-defstruct (xref-elisp-location") )) +(require 'em-xtra) +(require 'find-dired) (xref-elisp-deftest find-defs-defalias-defun-el - (elisp--xref-find-definitions 'Buffer-menu-sort) + (elisp--xref-find-definitions 'eshell/ff) (list - (xref-make "(defalias Buffer-menu-sort)" + (xref-make "(defalias eshell/ff)" (xref-make-elisp-location - 'Buffer-menu-sort 'defalias - (expand-file-name "../../../lisp/buff-menu.elc" emacs-test-dir))) - (xref-make "(defun tabulated-list-sort)" + 'eshell/ff 'defalias + (expand-file-name "../../../lisp/eshell/em-xtra.elc" + emacs-test-dir))) + (xref-make "(defun find-name-dired)" (xref-make-elisp-location - 'tabulated-list-sort nil - (expand-file-name "../../../lisp/emacs-lisp/tabulated-list.el" emacs-test-dir))) - )) + 'find-name-dired nil + (expand-file-name "../../../lisp/find-dired.el" + emacs-test-dir))))) ;; FIXME: defconst From 6735bb3d22dc64f3fe42e4a7f439ea9d62f75b5a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 20:59:44 +0100 Subject: [PATCH 261/297] Adjust the edebug spec for `interactive' * lisp/emacs-lisp/edebug.el: Adjust the edebug spec for `interactive' for the new syntax. --- lisp/emacs-lisp/edebug.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 7fae4d21d50..45996945948 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2136,7 +2136,8 @@ SPEC is the symbol name prefix for `gensym'." ;; more convenient to define their Edebug spec here. (defun ( &define name lambda-list lambda-doc [&optional ("declare" def-declarations)] - [&optional ("interactive" &optional &or stringp def-form)] + [&optional ("interactive" &optional [&or stringp def-form] + &rest symbolp)] def-body)) (defmacro ( &define name lambda-list lambda-doc @@ -2192,7 +2193,8 @@ SPEC is the symbol name prefix for `gensym'." '(&optional [&or stringp (&define ":documentation" def-form)])) -(def-edebug-elem-spec 'interactive '(&optional &or stringp def-form)) +(def-edebug-elem-spec 'interactive '(&optional [&or stringp def-form] + &rest symbolp)) ;; A function-form is for an argument that may be a function or a form. ;; This specially recognizes anonymous functions quoted with quote. From fbc9c59b9eb02d49f426341ee32334784d224ce4 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 17 Feb 2021 21:15:51 +0000 Subject: [PATCH 262/297] Make goto-line-history buffer local only when so customized * lisp/simple.el (goto-line-history-local): New customizable option. (goto-line-history): Define this simply with defvar, not defvar-local. (goto-line-read-args): Handle goto-line-history-local, and changes to it. * doc/emacs/basic.texi (Moving Point): Add a paragraph about goto-line-history-local. * etc/NEWS: Add an item under "Editing Changes in Emacs 28.1". --- doc/emacs/basic.texi | 5 +++++ etc/NEWS | 5 +++++ lisp/simple.el | 19 ++++++++++++++++++- 3 files changed, 28 insertions(+), 1 deletion(-) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 8bf52d5dd30..4a34fd36c5d 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -331,6 +331,11 @@ a plain prefix argument. Alternatively, you can use the command @code{goto-line-relative} to move point to the line relative to the accessible portion of the narrowed buffer. +@code{goto-line} has its own history list (@pxref{Minibuffer +History}). You can have either a single list shared between all +buffers (the default) or a separate list for each buffer, by +customizing the user option @code{goto-line-history-local}. + @item M-g @key{TAB} @kindex M-g TAB @findex move-to-column diff --git a/etc/NEWS b/etc/NEWS index b96bcd9eccd..7665d4740f9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -345,6 +345,11 @@ trying to be non-destructive. This command opens a new buffer called "*Memory Report*" and gives a summary of where Emacs is using memory currently. ++++ +** The history list for the 'goto-line' command is now a single list +for all buffers by default. You can configure a separate list for +each buffer by customizing the user option 'goto-line-history-local'. + ** Outline +++ diff --git a/lisp/simple.el b/lisp/simple.el index e54cbed7a76..363a0f26d5d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1278,7 +1278,19 @@ that uses or sets the mark." ;; Counting lines, one way or another. -(defvar-local goto-line-history nil +(defcustom goto-line-history-local nil + "If this option is nil, `goto-line-history' is shared between all buffers. +if it is non-nil, each buffer has its own value of this history list. + +Note that on changing from non-nil to nil, the former contents of +`goto-line-history' for each buffer are discarded on use of +`goto-line' in that buffer." + :group 'editing + :type 'boolean + :safe #'booleanp + :version "28.1") + +(defvar goto-line-history nil "History of values entered with `goto-line'.") (defun goto-line-read-args (&optional relative) @@ -1296,6 +1308,11 @@ that uses or sets the mark." (if buffer (concat " in " (buffer-name buffer)) ""))) + ;; Has the buffer locality of `goto-line-history' changed? + (cond ((and goto-line-history-local (not (local-variable-p 'goto-line-history))) + (make-local-variable 'goto-line-history)) + ((and (not goto-line-history-local) (local-variable-p 'goto-line-history)) + (kill-local-variable 'goto-line-history))) ;; Read the argument, offering that number (if any) as default. (list (read-number (format "Goto%s line%s: " (if (buffer-narrowed-p) From 79940d038f27c46507377a91fcf07fe94b80111a Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Wed, 17 Feb 2021 23:33:21 +0100 Subject: [PATCH 263/297] doc/lispref/commands.texi (Command Modes): Fix typo. * doc/lispref/commands.texi (Command Modes): Fix typo. --- doc/lispref/commands.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 85376cc4598..e171c3e168d 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -597,8 +597,8 @@ Put them into three windows, selecting the last one." @subsection Specifying Modes For Commands Many commands in Emacs are general, and not tied to any specific mode. -For instance, @kbd{M-x kill-region} can be used pretty in pretty much -any mode that has editable text, and commands that display information +For instance, @kbd{M-x kill-region} can be used in pretty much any +mode that has editable text, and commands that display information (like @kbd{M-x list-buffers}) can be used in pretty much any context. Many other commands, however, are specifically tied to a mode, and From 6d0089cabcc8c960cbc24e60481a916275a6833d Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 17 Feb 2021 22:48:18 +0000 Subject: [PATCH 264/297] ; Fix typo in last change to simple.el. --- lisp/simple.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/simple.el b/lisp/simple.el index 363a0f26d5d..b0a0896b682 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1280,7 +1280,7 @@ that uses or sets the mark." (defcustom goto-line-history-local nil "If this option is nil, `goto-line-history' is shared between all buffers. -if it is non-nil, each buffer has its own value of this history list. +If it is non-nil, each buffer has its own value of this history list. Note that on changing from non-nil to nil, the former contents of `goto-line-history' for each buffer are discarded on use of From a68a5fe03a8b11d00ca9a1de2a86caa3d97d4d35 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 17 Feb 2021 22:49:15 +0000 Subject: [PATCH 265/297] Fix recent Command Modes changes in Elisp manual * doc/lispref/commands.texi (Command Modes): Fix typos and grammar. Cross-reference the 'declare' form node. --- doc/lispref/commands.texi | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index e171c3e168d..1ad2df95919 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -603,10 +603,11 @@ mode that has editable text, and commands that display information Many other commands, however, are specifically tied to a mode, and make no sense outside of that context. For instance, @code{M-x -dired-diff} will just signal an error used outside of a dired buffer. +dired-diff} will just signal an error if used outside of a Dired +buffer. Emacs therefore has a mechanism for specifying what mode (or modes) a -command ``belong'' to: +command ``belongs'' to: @lisp (defun dired-diff (...) @@ -634,8 +635,8 @@ commands (if they aren't bound to any keys). If using this extended @code{interactive} form isn't convenient (because the code is supposed to work in older versions of Emacs that -doesn't support the extended @code{interactive} form), the following -can be used instead: +don't support the extended @code{interactive} form), the following +equivalent declaration (@pxref{Declare Form}) can be used instead: @lisp (declare (modes dired-mode)) @@ -657,10 +658,10 @@ call @code{kill-buffer}. This command will ``work'' from any mode, but it is highly unlikely that anybody would actually want to use the command outside the context of this special mode. -Many modes have a set of different commands that start that start the -mode in different ways, (e.g., @code{eww-open-in-new-buffer} and +Many modes have a set of different commands that start the mode in +different ways (e.g., @code{eww-open-in-new-buffer} and @code{eww-open-file}). Commands like that should never be tagged as -mode-specific, as then can be issued by the user from pretty much any +mode-specific, as they can be issued by the user from pretty much any context. @node Generic Commands From a10574c579cf072ace1db0f80a462a737ade45cb Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 17 Feb 2021 23:08:24 +0000 Subject: [PATCH 266/297] ; Fix another recent typo in simple.el. --- lisp/simple.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index b0a0896b682..d6ccdad9021 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1924,13 +1924,13 @@ to get different commands to edit and resubmit." (defcustom read-extended-command-predicate nil "Predicate to use to determine which commands to include when completing. If it's nil, include all the commands. -If it's a functoion, it will be called with two parameters: the +If it's a function, it will be called with two parameters: the symbol of the command and a buffer. The predicate should return non-nil if the command should be present when doing `M-x TAB' in that buffer." :version "28.1" :group 'completion - :type `(choice (const :tag "Don't exclude any commands" nil) + :type '(choice (const :tag "Don't exclude any commands" nil) (const :tag "Exclude commands irrelevant to current buffer's mode" command-completion-default-include-p) (function :tag "Other function"))) From 3fe2fb5794715b075fc1dd6d5d84bf10eae24c73 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 18 Feb 2021 01:41:03 +0200 Subject: [PATCH 267/297] Present C source files as absolute file names too when possible * lisp/progmodes/elisp-mode.el (xref-location-group): Present C source files as absolute file names too when possible (bug#46514). --- lisp/progmodes/elisp-mode.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 312153052d6..c14b18425f6 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -904,7 +904,13 @@ non-nil result supersedes the xrefs produced by (point-marker))))))) (cl-defmethod xref-location-group ((l xref-elisp-location)) - (xref-elisp-location-file l)) + (let ((file (xref-elisp-location-file l))) + (defvar find-function-C-source-directory) + (if (and find-function-C-source-directory + (string-match-p "\\`src/" file)) + (concat find-function-C-source-directory + (substring file 3)) + file))) (defun elisp-load-path-roots () (if (boundp 'package-user-dir) From 8358637936c455d906675932db4cbf90c35b6c53 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 18 Feb 2021 05:06:33 +0200 Subject: [PATCH 268/297] Move 'project-try-ede' to the back of 'project-find-functions' * lisp/cedet/ede.el (project-find-functions): Move 'project-try-ede' further back, so that 'project-try-vc' has priority (bug46202). --- lisp/cedet/ede.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index e3cc9062ed4..369a9f7e713 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -1518,7 +1518,7 @@ It does not apply the value to buffers." ;;; FIXME: Could someone look into implementing `project-ignores' for ;;; EDE and/or a faster `project-files'? -(add-hook 'project-find-functions #'project-try-ede) +(add-hook 'project-find-functions #'project-try-ede 50) (provide 'ede) From 892db042a0d85caeea9a4969073e13f525eb9f60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Feb 2021 11:11:11 +0100 Subject: [PATCH 269/297] Fix rx `regexp` form with deprecated syntax The argument of the rx `regexp` form is assumed to evaluate to a valid regexp, but certain kinds of deprecated but still accepted usage were not handled correctly, such as unescaped literal (special) characters: (rx "a" (regexp "*")) => "a*" which is wrong. Handle these cases; there is no extra trouble. * lisp/emacs-lisp/rx.el (rx--translate-regexp): Force bracketing of single special characters. * test/lisp/emacs-lisp/rx-tests.el (rx-regexp): Add test case. --- lisp/emacs-lisp/rx.el | 2 +- test/lisp/emacs-lisp/rx-tests.el | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index b29b870061d..58584f300c9 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -890,7 +890,7 @@ Return (REGEXP . PRECEDENCE)." (* (or (seq "[:" (+ (any "a-z")) ":]") (not (any "]")))) "]") - anything + (not (any "*+?^$[\\")) (seq "\\" (or anything (seq (any "sScC_") anything) diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 63d7c7b91ea..388c5e86b4c 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -391,6 +391,8 @@ (let ((x "a*")) (should (equal (rx (regexp x) "b") "\\(?:a*\\)b")) + (should (equal (rx "a" (regexp "*")) + "a\\(?:*\\)")) (should (equal (rx "" (regexp x) (eval "")) "a*")))) From 546f552e7b2439b482c7d28222fb88761a9c876a Mon Sep 17 00:00:00 2001 From: Doug Davis Date: Thu, 18 Feb 2021 12:39:00 +0100 Subject: [PATCH 270/297] Do interactive mode tagging for python.el navigation functions. * lisp/progmodes/python.el (navigation functions): Add python-mode to `interactive' declarations for mode-specific commands (bug#46610). Copyright-paperwork-exempt: yes --- lisp/progmodes/python.el | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index afb96974b17..7506043a190 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1506,7 +1506,7 @@ point position. Return non-nil if point is moved to (defun python-nav-end-of-defun () "Move point to the end of def or class. Returns nil if point is not in a def or class." - (interactive) + (interactive nil python-mode) (let ((beg-defun-indent) (beg-pos (point))) (when (or (python-info-looking-at-beginning-of-defun) @@ -1577,19 +1577,19 @@ repeat it." "Navigate to closer defun backward ARG times. Unlikely `python-nav-beginning-of-defun' this doesn't care about nested definitions." - (interactive "^p") + (interactive "^p" python-mode) (python-nav--forward-defun (- (or arg 1)))) (defun python-nav-forward-defun (&optional arg) "Navigate to closer defun forward ARG times. Unlikely `python-nav-beginning-of-defun' this doesn't care about nested definitions." - (interactive "^p") + (interactive "^p" python-mode) (python-nav--forward-defun (or arg 1))) (defun python-nav-beginning-of-statement () "Move to start of current statement." - (interactive "^") + (interactive "^" python-mode) (forward-line 0) (let* ((ppss (syntax-ppss)) (context-point @@ -1613,7 +1613,7 @@ nested definitions." Optional argument NOEND is internal and makes the logic to not jump to the end of line when moving forward searching for the end of the statement." - (interactive "^") + (interactive "^" python-mode) (let (string-start bs-pos (last-string-end 0)) (while (and (or noend (goto-char (line-end-position))) (not (eobp)) @@ -1654,7 +1654,7 @@ Overlapping strings detected (start=%d, last-end=%d)") (defun python-nav-backward-statement (&optional arg) "Move backward to previous statement. With ARG, repeat. See `python-nav-forward-statement'." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (python-nav-forward-statement (- arg))) @@ -1662,7 +1662,7 @@ With ARG, repeat. See `python-nav-forward-statement'." "Move forward to next statement. With ARG, repeat. With negative argument, move ARG times backward to previous statement." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (while (> arg 0) (python-nav-end-of-statement) @@ -1677,7 +1677,7 @@ backward to previous statement." (defun python-nav-beginning-of-block () "Move to start of current block." - (interactive "^") + (interactive "^" python-mode) (let ((starting-pos (point))) (if (progn (python-nav-beginning-of-statement) @@ -1701,7 +1701,7 @@ backward to previous statement." (defun python-nav-end-of-block () "Move to end of current block." - (interactive "^") + (interactive "^" python-mode) (when (python-nav-beginning-of-block) (let ((block-indentation (current-indentation))) (python-nav-end-of-statement) @@ -1717,7 +1717,7 @@ backward to previous statement." (defun python-nav-backward-block (&optional arg) "Move backward to previous block of code. With ARG, repeat. See `python-nav-forward-block'." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (python-nav-forward-block (- arg))) @@ -1725,7 +1725,7 @@ With ARG, repeat. See `python-nav-forward-block'." "Move forward to next block of code. With ARG, repeat. With negative argument, move ARG times backward to previous block." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (let ((block-start-regexp (python-rx line-start (* whitespace) block-start)) @@ -1878,7 +1878,7 @@ throw errors when at end of sexp, skip it instead. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) ;; Do not follow parens on interactive calls. This hack to detect ;; if the function was called interactively copes with the way @@ -1912,7 +1912,7 @@ throw errors when at end of sexp, skip it instead. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (python-nav-forward-sexp (- arg) safe skip-parens-p)) @@ -1922,7 +1922,7 @@ With ARG, do it that many times. Negative arg -N means move backward N times. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p") + (interactive "^p" python-mode) (python-nav-forward-sexp arg t skip-parens-p)) (defun python-nav-backward-sexp-safe (&optional arg skip-parens-p) @@ -1931,7 +1931,7 @@ With ARG, do it that many times. Negative arg -N means move forward N times. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p") + (interactive "^p" python-mode) (python-nav-backward-sexp arg t skip-parens-p)) (defun python-nav--up-list (&optional dir) @@ -1977,7 +1977,7 @@ DIR is always 1 or -1 and comes sanitized from With ARG, do this that many times. A negative argument means move backward but still to a less deep spot. This command assumes point is not in a string or comment." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (while (> arg 0) (python-nav--up-list 1) @@ -1991,7 +1991,7 @@ This command assumes point is not in a string or comment." With ARG, do this that many times. A negative argument means move forward but still to a less deep spot. This command assumes point is not in a string or comment." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (python-nav-up-list (- arg))) @@ -1999,7 +1999,7 @@ This command assumes point is not in a string or comment." "Move point at the beginning the __main__ block. When \"if __name__ == \\='__main__\\=':\" is found returns its position, else returns nil." - (interactive) + (interactive nil python-mode) (let ((point (point)) (found (catch 'found (goto-char (point-min)) From 850f18ef23ded4aff38afee89de7980e1c9dd1fd Mon Sep 17 00:00:00 2001 From: Ryan Prior Date: Thu, 18 Feb 2021 12:48:28 +0100 Subject: [PATCH 271/297] Allow newlines in password prompts again in comint * lisp/comint.el (comint-password-prompt-regexp): Match all whitespace (including newline) at the end of the passphrase, not just space and \t (bug#46609). (comint-watch-for-password-prompt): Remove trailing newlines from the prompt (bug#46609). Copyright-paperwork-exempt: yes --- lisp/comint.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/comint.el b/lisp/comint.el index f5abd1a5bc3..24ef0f239b2 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -366,7 +366,7 @@ This variable is buffer-local." "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)" "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?" ;; "[[:alpha:]]" used to be "for", which fails to match non-English. - "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:blank:]]*\\'") + "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:space:]]*\\'") "Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." :version "27.1" @@ -2405,6 +2405,8 @@ This function could be in the list `comint-output-filter-functions'." (string-match comint-password-prompt-regexp string)) (when (string-match "^[ \n\r\t\v\f\b\a]+" string) (setq string (replace-match "" t t string))) + (when (string-match "\n+\\'" string) + (setq string (replace-match "" t t string))) (let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth))) (if (> comint--prompt-recursion-depth 10) (message "Password prompt recursion too deep") From eb9f80e37b42576dd5a86c89e18d44ad2cec4273 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 18 Feb 2021 12:52:55 +0100 Subject: [PATCH 272/297] Revert "Do interactive mode tagging for python.el navigation functions." This reverts commit 546f552e7b2439b482c7d28222fb88761a9c876a. This is a "core package", so can't use the new syntax. --- lisp/progmodes/python.el | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 7506043a190..afb96974b17 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1506,7 +1506,7 @@ point position. Return non-nil if point is moved to (defun python-nav-end-of-defun () "Move point to the end of def or class. Returns nil if point is not in a def or class." - (interactive nil python-mode) + (interactive) (let ((beg-defun-indent) (beg-pos (point))) (when (or (python-info-looking-at-beginning-of-defun) @@ -1577,19 +1577,19 @@ repeat it." "Navigate to closer defun backward ARG times. Unlikely `python-nav-beginning-of-defun' this doesn't care about nested definitions." - (interactive "^p" python-mode) + (interactive "^p") (python-nav--forward-defun (- (or arg 1)))) (defun python-nav-forward-defun (&optional arg) "Navigate to closer defun forward ARG times. Unlikely `python-nav-beginning-of-defun' this doesn't care about nested definitions." - (interactive "^p" python-mode) + (interactive "^p") (python-nav--forward-defun (or arg 1))) (defun python-nav-beginning-of-statement () "Move to start of current statement." - (interactive "^" python-mode) + (interactive "^") (forward-line 0) (let* ((ppss (syntax-ppss)) (context-point @@ -1613,7 +1613,7 @@ nested definitions." Optional argument NOEND is internal and makes the logic to not jump to the end of line when moving forward searching for the end of the statement." - (interactive "^" python-mode) + (interactive "^") (let (string-start bs-pos (last-string-end 0)) (while (and (or noend (goto-char (line-end-position))) (not (eobp)) @@ -1654,7 +1654,7 @@ Overlapping strings detected (start=%d, last-end=%d)") (defun python-nav-backward-statement (&optional arg) "Move backward to previous statement. With ARG, repeat. See `python-nav-forward-statement'." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (python-nav-forward-statement (- arg))) @@ -1662,7 +1662,7 @@ With ARG, repeat. See `python-nav-forward-statement'." "Move forward to next statement. With ARG, repeat. With negative argument, move ARG times backward to previous statement." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (while (> arg 0) (python-nav-end-of-statement) @@ -1677,7 +1677,7 @@ backward to previous statement." (defun python-nav-beginning-of-block () "Move to start of current block." - (interactive "^" python-mode) + (interactive "^") (let ((starting-pos (point))) (if (progn (python-nav-beginning-of-statement) @@ -1701,7 +1701,7 @@ backward to previous statement." (defun python-nav-end-of-block () "Move to end of current block." - (interactive "^" python-mode) + (interactive "^") (when (python-nav-beginning-of-block) (let ((block-indentation (current-indentation))) (python-nav-end-of-statement) @@ -1717,7 +1717,7 @@ backward to previous statement." (defun python-nav-backward-block (&optional arg) "Move backward to previous block of code. With ARG, repeat. See `python-nav-forward-block'." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (python-nav-forward-block (- arg))) @@ -1725,7 +1725,7 @@ With ARG, repeat. See `python-nav-forward-block'." "Move forward to next block of code. With ARG, repeat. With negative argument, move ARG times backward to previous block." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (let ((block-start-regexp (python-rx line-start (* whitespace) block-start)) @@ -1878,7 +1878,7 @@ throw errors when at end of sexp, skip it instead. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) ;; Do not follow parens on interactive calls. This hack to detect ;; if the function was called interactively copes with the way @@ -1912,7 +1912,7 @@ throw errors when at end of sexp, skip it instead. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (python-nav-forward-sexp (- arg) safe skip-parens-p)) @@ -1922,7 +1922,7 @@ With ARG, do it that many times. Negative arg -N means move backward N times. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p" python-mode) + (interactive "^p") (python-nav-forward-sexp arg t skip-parens-p)) (defun python-nav-backward-sexp-safe (&optional arg skip-parens-p) @@ -1931,7 +1931,7 @@ With ARG, do it that many times. Negative arg -N means move forward N times. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p" python-mode) + (interactive "^p") (python-nav-backward-sexp arg t skip-parens-p)) (defun python-nav--up-list (&optional dir) @@ -1977,7 +1977,7 @@ DIR is always 1 or -1 and comes sanitized from With ARG, do this that many times. A negative argument means move backward but still to a less deep spot. This command assumes point is not in a string or comment." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (while (> arg 0) (python-nav--up-list 1) @@ -1991,7 +1991,7 @@ This command assumes point is not in a string or comment." With ARG, do this that many times. A negative argument means move forward but still to a less deep spot. This command assumes point is not in a string or comment." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (python-nav-up-list (- arg))) @@ -1999,7 +1999,7 @@ This command assumes point is not in a string or comment." "Move point at the beginning the __main__ block. When \"if __name__ == \\='__main__\\=':\" is found returns its position, else returns nil." - (interactive nil python-mode) + (interactive) (let ((point (point)) (found (catch 'found (goto-char (point-min)) From 9882e63eeaed54244a6b608685dd748f72ef66a6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Feb 2021 16:07:34 +0200 Subject: [PATCH 273/297] ; * CONTRIBUTE: Another wording change regarding tiny changes. --- CONTRIBUTE | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index b7d72f9965e..fe773510d36 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -66,9 +66,9 @@ more reliably, and makes the job of applying the patches easier and less error-prone. It also allows sending patches whose author is someone other than the email sender. -Once the cumulative amount of your submissions exceeds about 10 lines -of non-trivial changes, we will need you to assign to the FSF the -copyright for your contributions. (To see how many lines were +Once the cumulative amount of your submissions exceeds a dozen or so +lines of non-trivial changes, we will need you to assign to the FSF +the copyright for your contributions. (To see how many lines were non-trivially changed, count only added and modified lines in the patched code. Consider an added or changed line non-trivial if it includes at least one identifier, string, or substantial comment.) From bae2cfe63cbd11eaf348dfa7fbb2b9f7362fc747 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Feb 2021 10:27:36 -0500 Subject: [PATCH 274/297] * lisp/emacs-lisp/edebug.el (eval-defun): Simplify (edebug-all-defs, edebug-all-forms): Don't autoload since the problem it was working around has been fixed a while back. (edebug--eval-defun): Rename from `edebug-eval-defun` and simplify by making it an `:around` advice. (edebug-install-read-eval-functions) (edebug-uninstall-read-eval-functions): Adjust accordingly. (edebug-eval-defun): Redefine as an obsolete wrapper. * lisp/progmodes/elisp-mode.el (elisp--eval-defun): Use `load-read-function` so it obeys `edebug-all-(defs|forms)`. (elisp--eval-defun): Fix recent regression introduced with `elisp--eval-defun-result`. --- lisp/emacs-lisp/edebug.el | 74 +++++++----------------------------- lisp/progmodes/elisp-mode.el | 12 ++++-- 2 files changed, 21 insertions(+), 65 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 45996945948..45e76c751fe 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -88,7 +88,6 @@ using, but only when you also use Edebug." ;; because the byte compiler binds them; as a result, if edebug ;; is first loaded for a require in a compilation, they will be left unbound. -;;;###autoload (defcustom edebug-all-defs nil "If non-nil, evaluating defining forms instruments for Edebug. This applies to `eval-defun', `eval-region', `eval-buffer', and @@ -101,11 +100,6 @@ variable. You may wish to make it local to each buffer with `emacs-lisp-mode-hook'." :type 'boolean) -;; edebug-all-defs and edebug-all-forms need to be autoloaded -;; because the byte compiler binds them; as a result, if edebug -;; is first loaded for a require in a compilation, they will be left unbound. - -;;;###autoload (defcustom edebug-all-forms nil "Non-nil means evaluation of all forms will instrument for Edebug. This doesn't apply to loading or evaluations in the minibuffer. @@ -457,66 +451,24 @@ the option `edebug-all-forms'." ;; We should somehow arrange to be able to do this ;; without actually replacing the eval-defun command. -(defun edebug-eval-defun (edebug-it) - "Evaluate the top-level form containing point, or after point. - -If the current defun is actually a call to `defvar', then reset the -variable using its initial value expression even if the variable -already has some other value. (Normally `defvar' does not change the -variable's value if it already has a value.) Treat `defcustom' -similarly. Reinitialize the face according to `defface' specification. - -With a prefix argument, instrument the code for Edebug. - -Setting option `edebug-all-defs' to a non-nil value reverses the meaning +(defun edebug--eval-defun (orig-fun edebug-it) + "Setting option `edebug-all-defs' to a non-nil value reverses the meaning of the prefix argument. Code is then instrumented when this function is invoked without a prefix argument. If acting on a `defun' for FUNCTION, and the function was instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not instrumented, -just FUNCTION is printed. +just FUNCTION is printed." + (let* ((edebug-all-forms (not (eq (not edebug-it) (not edebug-all-defs)))) + (edebug-all-defs edebug-all-forms)) + (funcall orig-fun nil))) -If not acting on a `defun', the result of evaluation is displayed in -the minibuffer." +(defun edebug-eval-defun (edebug-it) + (declare (obsolete "use eval-defun or edebug--eval-defun instead" "28.1")) (interactive "P") - (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs)))) - (edebug-result) - (form - (let ((edebug-all-forms edebugging) - (edebug-all-defs (eq edebug-all-defs (not edebug-it)))) - (edebug-read-top-level-form)))) - ;; This should be consistent with `eval-defun-1', but not the - ;; same, since that gets a macroexpanded form. - (cond ((and (eq (car form) 'defvar) - (cdr-safe (cdr-safe form))) - ;; Force variable to be bound. - (makunbound (nth 1 form))) - ((and (eq (car form) 'defcustom) - (default-boundp (nth 1 form))) - ;; Force variable to be bound. - ;; FIXME: Shouldn't this use the :setter or :initializer? - (set-default (nth 1 form) (eval (nth 2 form) lexical-binding))) - ((eq (car form) 'defface) - ;; Reset the face. - (setq face-new-frame-defaults - (assq-delete-all (nth 1 form) face-new-frame-defaults)) - (put (nth 1 form) 'face-defface-spec nil) - (put (nth 1 form) 'face-documentation (nth 3 form)) - ;; See comments in `eval-defun-1' for purpose of code below - (setq form (prog1 `(prog1 ,form - (put ',(nth 1 form) 'saved-face - ',(get (nth 1 form) 'saved-face)) - (put ',(nth 1 form) 'customized-face - ,(nth 2 form))) - (put (nth 1 form) 'saved-face nil))))) - (setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding)) - (if (not edebugging) - (prog1 - (prin1 edebug-result) - (let ((str (eval-expression-print-format edebug-result))) - (if str (princ str)))) - edebug-result))) - + (if (advice-member-p #'edebug--eval-defun 'eval-defun) + (eval-defun edebug-it) + (edebug--eval-defun #'eval-defun edebug-it))) ;;;###autoload (defalias 'edebug-defun 'edebug-eval-top-level-form) @@ -588,12 +540,12 @@ already is one.)" (defun edebug-install-read-eval-functions () (interactive) (add-function :around load-read-function #'edebug--read) - (advice-add 'eval-defun :override #'edebug-eval-defun)) + (advice-add 'eval-defun :around #'edebug--eval-defun)) (defun edebug-uninstall-read-eval-functions () (interactive) (remove-function load-read-function #'edebug--read) - (advice-remove 'eval-defun #'edebug-eval-defun)) + (advice-remove 'eval-defun #'edebug--eval-defun)) ;;; Edebug internal data diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index c14b18425f6..397eb269a71 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1342,6 +1342,7 @@ if it already has a value.) Return the result of evaluation." ;; FIXME: the print-length/level bindings should only be applied while ;; printing, not while evaluating. + (defvar elisp--eval-defun-result) (let ((debug-on-error eval-expression-debug-on-error) (print-length eval-expression-print-length) (print-level eval-expression-print-level) @@ -1357,19 +1358,22 @@ Return the result of evaluation." (end-of-defun) (beginning-of-defun) (setq beg (point)) - (setq form (read (current-buffer))) + (setq form (funcall load-read-function (current-buffer))) (setq end (point))) ;; Alter the form if necessary. (let ((form (eval-sexp-add-defvars (elisp--eval-defun-1 - (macroexpand - `(setq elisp--eval-defun-result ,form)))))) + (macroexpand form))))) (eval-region beg end standard-output (lambda (_ignore) ;; Skipping to the end of the specified region ;; will make eval-region return. (goto-char end) - form))))) + ;; This `setq' needs to be added *after* passing + ;; form through `elisp--eval-defun-1' since it + ;; would otherwise "hide" forms like `defvar's and + ;; thus defeat their special treatment. + `(setq elisp--eval-defun-result ,form)))))) (let ((str (eval-expression-print-format elisp--eval-defun-result))) (if str (princ str))) elisp--eval-defun-result)) From de15ca7d0065c5f77c88a90f4f14569886be3617 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Feb 2021 16:41:36 +0100 Subject: [PATCH 275/297] Fix typos * doc/lispref/display.texi (Size of Displayed Text): * doc/lispref/windows.texi (Buffer Display Action Functions): * etc/NEWS: * etc/ORG-NEWS (Org-Attach has been refactored and extended): * lisp/battery.el (display-battery-mode, battery--upower-subsribe): * lisp/calendar/parse-time.el: * lisp/dired-x.el: * lisp/emacs-lisp/chart.el (chart-sequece, chart-bar-quickie): * lisp/emacs-lisp/eldoc.el (eldoc-echo-area-use-multiline-p) (eldoc-documentation-strategy): * lisp/emacs-lisp/pcase.el (pcase--split-pred, pcase--u1): * lisp/gnus/gnus-search.el (gnus-search-expandable-keys) (gnus-search-parse-query, gnus-search-query-return-string) (gnus-search-imap, gnus-search-imap-search-command) (gnus-search-transform-expression): * lisp/gnus/nnselect.el: * lisp/isearch.el (isearch-lazy-count-format): * lisp/mh-e/mh-show.el (mh-show-msg): * lisp/net/dictionary-connection.el (dictionary-connection-open): * lisp/net/dictionary.el (dictionary-default-popup-strategy) (dictionary, dictionary-split-string, dictionary-do-select-dictionary) (dictionary-display-dictionarys, dictionary-search) (dictionary-tooltip-mode): * lisp/net/eudcb-macos-contacts.el (eudc-macos-contacts-set-server): * lisp/net/mailcap.el (mailcap-mime-data): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): * lisp/nxml/nxml-mode.el (nxml-mode): * lisp/progmodes/cc-engine.el: * lisp/progmodes/cperl-mode.el (cperl-mode) (cperl-fontify-syntaxically): * lisp/progmodes/flymake.el (flymake-diagnostic-functions): * lisp/progmodes/verilog-mode.el (verilog--supressed-warnings) (verilog-preprocess): * lisp/simple.el (self-insert-uses-region-functions): * lisp/textmodes/bibtex.el (bibtex-copy-summary-as-kill): * lisp/textmodes/texnfo-upd.el (texinfo-insert-master-menu-list): * src/dispnew.c: * src/font.c (Ffont_get): * src/indent.c (compute_motion): * src/process.c (init_process_emacs): * src/w32fns.c (deliver_wm_chars): * test/lisp/jsonrpc-tests.el (deferred-action-complex-tests): Fix typos in documentation, comments, and internal identifiers. --- doc/lispref/display.texi | 2 +- doc/lispref/windows.texi | 2 +- etc/NEWS | 2 +- etc/ORG-NEWS | 2 +- lisp/battery.el | 4 ++-- lisp/calendar/parse-time.el | 2 +- lisp/dired-x.el | 2 +- lisp/emacs-lisp/chart.el | 6 +++--- lisp/emacs-lisp/eldoc.el | 4 ++-- lisp/emacs-lisp/pcase.el | 4 ++-- lisp/gnus/gnus-search.el | 16 ++++++++-------- lisp/gnus/nnselect.el | 2 +- lisp/isearch.el | 2 +- lisp/mh-e/mh-show.el | 2 +- lisp/net/dictionary-connection.el | 6 +++--- lisp/net/dictionary.el | 20 ++++++++++---------- lisp/net/eudcb-macos-contacts.el | 2 +- lisp/net/mailcap.el | 2 +- lisp/net/tramp-smb.el | 2 +- lisp/nxml/nxml-mode.el | 2 +- lisp/progmodes/cc-engine.el | 2 +- lisp/progmodes/cperl-mode.el | 6 +++--- lisp/progmodes/flymake.el | 2 +- lisp/progmodes/verilog-mode.el | 4 ++-- lisp/simple.el | 2 +- lisp/textmodes/bibtex.el | 2 +- lisp/textmodes/texnfo-upd.el | 2 +- src/dispnew.c | 2 +- src/font.c | 2 +- src/indent.c | 2 +- src/process.c | 2 +- src/w32fns.c | 2 +- test/lisp/jsonrpc-tests.el | 2 +- 33 files changed, 59 insertions(+), 59 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 93e935ccf86..131ad2d9c87 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1997,7 +1997,7 @@ the beginning of the result if a multi-column character in If @var{ellipsis} is non-@code{nil}, it should be a string which will replace the end of @var{string} when it is truncated. In this case, -more charcaters will be removed from @var{string} to free enough space +more characters will be removed from @var{string} to free enough space for @var{ellipsis} to fit within @var{width} columns. However, if the display width of @var{string} is less than the display width of @var{ellipsis}, @var{ellipsis} will not be appended to the result. If diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f305d1a8ee8..c32d711f12a 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2557,7 +2557,7 @@ frame visible and, unless @var{alist} contains an This function tries to display @var{buffer} by finding a window that is displaying a buffer in a given mode. -If @var{alist} contains a @code{mode} entry, its value specifes a +If @var{alist} contains a @code{mode} entry, its value specifies a major mode (a symbol) or a list of major modes. If @var{alist} contains no @code{mode} entry, the current major mode of @var{buffer} is used instead. A window is a candidate if it displays a buffer diff --git a/etc/NEWS b/etc/NEWS index 7665d4740f9..ee8a68a259d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1015,7 +1015,7 @@ separate buffer, or a tooltip. *** New user option 'eldoc-documentation-strategy'. The built-in choices available for this user option let users compose the results of 'eldoc-documentation-functions' in various ways, even -if some of those functions are sychronous and some asynchchronous. +if some of those functions are synchronous and some asynchronous. The user option replaces 'eldoc-documentation-function', which is now obsolete. diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 2cae8b92ace..2b9cbf37c45 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -747,7 +747,7 @@ removed. For those who hate breaking changes, even though the changes are made to clean things up; fear not. ATTACH_DIR will still continue to work. It's just not documented any longer. When you get the chance, run the -code above to clean things up anyways! +code above to clean things up anyway! **** New hooks Two hooks are added to org-attach: diff --git a/lisp/battery.el b/lisp/battery.el index 77ad73d15d7..59f6987ad16 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -246,7 +246,7 @@ seconds." (add-to-list 'global-mode-string 'battery-mode-line-string t) (and (eq battery-status-function #'battery-upower) battery-upower-subscribe - (battery--upower-subsribe)) + (battery--upower-subscribe)) (setq battery-update-timer (run-at-time nil battery-update-interval #'battery-update-handler)) (battery-update)) @@ -634,7 +634,7 @@ Intended as a UPower PropertiesChanged signal handler." (mapc #'dbus-unregister-object battery--upower-signals) (setq battery--upower-signals ())) -(defun battery--upower-subsribe () +(defun battery--upower-subscribe () "Subscribe to UPower device change signals." (push (dbus-register-signal :system battery-upower-service battery-upower-path diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index ba7418faf78..aa3236cf256 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -29,7 +29,7 @@ ;; `parse-time-string' parses a time in a string and returns a list of ;; values, just like `decode-time', where unspecified elements in the -;; string are returned as nil (except unspecfied DST is returned as -1). +;; string are returned as nil (except unspecified DST is returned as -1). ;; `encode-time' may be applied on these values to obtain an internal ;; time value. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 5a52eccbbe3..1199de183fb 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -447,7 +447,7 @@ If it is `no-dir', omitting is much faster, but you can only match against the non-directory part of the file name. Set it to nil if you need to match the entire file name.") -;; \017=^O for Omit - other packages can chose other control characters. +;; \017=^O for Omit - other packages can choose other control characters. (defvar dired-omit-marker-char ?\017 "Temporary marker used by Dired-Omit. Should never be used as marker by the user or other packages.") diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 7d760ffc57f..40c17b916f9 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -187,7 +187,7 @@ Make sure the width/height is correct." ) "Class used to display an axis which represents different named items.") -(defclass chart-sequece () +(defclass chart-sequence () ((data :initarg :data :initform nil) (name :initarg :name @@ -583,12 +583,12 @@ SORT-PRED if desired." )) (iv (eq dir 'vertical))) (chart-add-sequence nc - (make-instance 'chart-sequece + (make-instance 'chart-sequence :data namelst :name nametitle) (if iv 'x-axis 'y-axis)) (chart-add-sequence nc - (make-instance 'chart-sequece + (make-instance 'chart-sequence :data numlst :name numtitle) (if iv 'y-axis 'x-axis)) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index c95540ea3cf..a02406a7b73 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -100,7 +100,7 @@ If the value is a positive number, it is used to calculate a number of logical lines of documentation that ElDoc is allowed to put in the echo area. If a positive integer, the number is used directly, while a float specifies the number of lines as a -proporting of the echo area frame's height. +proportion of the echo area frame's height. If value is the symbol `truncate-sym-name-if-fit' t, the part of the doc string that represents a symbol's name may be truncated @@ -692,7 +692,7 @@ following values are allowed: - `eldoc-documentation-compose-eagerly': calls all functions in the special hook and display as many of the resulting doc - strings as possible, as soon as possibl. Preserving the + strings as possible, as soon as possible. Preserving the relative order of doc strings; - `eldoc-documentation-enthusiast': calls all functions in the diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index d3928fa5051..c7288b7fa2a 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -642,7 +642,7 @@ MATCH is the pattern that needs to be matched, of the form: (defun pcase--split-pred (vars upat pat) "Indicate the overlap or mutual-exclusion between UPAT and PAT. -More specifically retuns a pair (A . B) where A indicates whether PAT +More specifically returns a pair (A . B) where A indicates whether PAT can match when UPAT has matched, and B does the same for the case where UPAT failed to match. A and B can be one of: @@ -784,7 +784,7 @@ Otherwise, it defers to REST which is a list of branches of the form \(ELSE-MATCH ELSE-CODE . ELSE-VARS)." ;; Depending on the order in which we choose to check each of the MATCHES, ;; the resulting tree may be smaller or bigger. So in general, we'd want - ;; to be careful to chose the "optimal" order. But predicate + ;; to be careful to choose the "optimal" order. But predicate ;; patterns make this harder because they create dependencies ;; between matches. So we don't bother trying to reorder anything. (cond diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index d7b1c06114b..339bff9d67a 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -365,7 +365,7 @@ This variable can also be set per-server." "A list of strings representing expandable search keys. \"Expandable\" simply means the key can be abbreviated while typing in search queries, ie \"subject\" could be entered as -\"subj\" or even \"su\", though \"s\" is ambigous between +\"subj\" or even \"su\", though \"s\" is ambiguous between \"subject\" and \"since\". Ambiguous abbreviations will raise an error." @@ -402,7 +402,7 @@ The search \"language\" is essentially a series of key:value expressions. Key is most often a mail header, but there are other keys. Value is a string, quoted if it contains spaces. Key and value are separated by a colon, no space. Expressions -are implictly ANDed; the \"or\" keyword can be used to +are implicitly ANDed; the \"or\" keyword can be used to OR. \"not\" will negate the following expression, or keys can be prefixed with a \"-\". The \"near\" operator will work for engines that understand it; other engines will convert it to @@ -448,7 +448,7 @@ 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 occurance thereof (ie \"march 03\" +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. @@ -646,7 +646,7 @@ 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 -occurance of the delimiter, including the delimiters themselves. +occurence 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 @@ -789,7 +789,7 @@ the files in ARTLIST by that search key.") (raw-queries-p :initform (symbol-value 'gnus-search-imap-raw-queries-p))) :documentation - "The base IMAP search engine, using an IMAP server's search capabilites. + "The base IMAP search engine, using an IMAP server's search capabilities. This backend may be subclassed to handle particular IMAP servers' quirks.") @@ -1082,7 +1082,7 @@ Responsible for handling and, or, and parenthetical expressions.") (cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap) (query string)) "Create the IMAP search command for QUERY. -Currenly takes into account support for the LITERAL+ capability. +Currently takes into account support for the LITERAL+ capability. Other capabilities could be tested here." (with-slots (literal-plus) engine (when literal-plus @@ -1672,8 +1672,8 @@ and \"-\" before marks." (cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix) (expr (head or))) "Handle Mairix \"or\" statement. -Mairix only accepts \"or\" expressions on homogenous keys. We -cast \"or\" expressions on heterogenous keys as \"and\", which +Mairix only accepts \"or\" expressions on homogeneous keys. We +cast \"or\" expressions on heterogeneous keys as \"and\", which isn't quite right, but it's the best we can do. For date keys, only keep one of the terms." (let ((term1 (caadr expr)) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index fffa2d27312..1daa8aa673b 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -33,7 +33,7 @@ ;; turn be a vector of three elements: a real prefixed group name, an ;; article number in that group, and an integer score. The score is ;; not used by nnselect but may be used by other code to help in -;; sorting. Most functions will just chose a fixed number, such as +;; sorting. Most functions will just choose a fixed number, such as ;; 100, for this score. ;; For example the search function `gnus-search-run-query' applied to diff --git a/lisp/isearch.el b/lisp/isearch.el index c571ea94670..8266c4b7a01 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3356,7 +3356,7 @@ the word mode." (defun isearch-lazy-count-format (&optional suffix-p) "Format the current match number and the total number of matches. -When SUFFIX-P is non-nil, the returned string is indended for +When SUFFIX-P is non-nil, the returned string is intended for isearch-message-suffix prompt. Otherwise, for isearch-message-prefix." (let ((format-string (if suffix-p lazy-count-suffix-format diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 9ad843c3259..1d25b147323 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -136,7 +136,7 @@ displayed." (show-window (get-buffer-window mh-show-buffer)) (display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag)) (if (not (eq (next-window (minibuffer-window)) (selected-window))) - (delete-other-windows)) ; force ourself to the top window + (delete-other-windows)) ; force ourselves to the top window (mh-in-show-buffer (mh-show-buffer) (setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag) (if (and show-window diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index 8ad4fe4e637..83125742be3 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -23,9 +23,9 @@ ;;; Commentary: ;; dictionary-connection allows to handle TCP-based connections in -;; client mode where text-based information are exchanged. There is +;; client mode where text-based information is exchanged. There is ;; special support for handling CR LF (and the usual CR LF . CR LF -;; terminater). +;; terminator). ;;; Code: @@ -68,7 +68,7 @@ (defun dictionary-connection-open (server port) "Open a connection to SERVER at PORT. -A data structure identifing the connection is returned" +A data structure identifying the connection is returned" (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" server diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 6f086053b6a..c6af4e66e39 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -127,9 +127,9 @@ by the choice value: The found word exactly matches the searched word. -- Similiar sounding +- Similar sounding - The found word sounds similiar to the searched word. For this match type + The found word sounds similar to the searched word. For this match type the soundex algorithm defined by Donald E. Knuth is used. It will only works with english words and the algorithm is not very reliable (i.e., the soundex algorithm is quite simple). @@ -148,7 +148,7 @@ by the choice value: dictionary server." :group 'dictionary :type '(choice (const :tag "Exact match" "exact") - (const :tag "Similiar sounding" "soundex") + (const :tag "Similar sounding" "soundex") (const :tag "Levenshtein distance one" "lev") (string :tag "User choice")) :version "28.1") @@ -419,7 +419,7 @@ This is a quick reference to this mode describing the default key bindings: ;;;###autoload (defun dictionary () - "Create a new dictonary buffer and install `dictionary-mode'." + "Create a new dictionary buffer and install `dictionary-mode'." (interactive) (let ((buffer (or (and dictionary-use-single-buffer (get-buffer "*Dictionary*")) @@ -568,7 +568,7 @@ The connection takes the proxy setting in customization group answer))) (defun dictionary-split-string (string) - "Split STRING constiting of space-separated words into elements. + "Split STRING consisting of space-separated words into elements. This function knows about the special meaning of quotes (\")" (let ((list)) (while (and string (> (length string) 0)) @@ -894,7 +894,7 @@ The word is taken from the buffer, the DICTIONARY is given as argument." (unless (dictionary-check-reply reply 110) (error "Unknown server answer: %s" (dictionary-reply reply))) - (dictionary-display-dictionarys)))) + (dictionary-display-dictionaries)))) (defun dictionary-simple-split-string (string &optional pattern) "Return a list of substrings of STRING which are separated by PATTERN. @@ -909,7 +909,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." start (match-end 0))) (nreverse (cons (substring string start) parts)))) -(defun dictionary-display-dictionarys () +(defun dictionary-display-dictionaries () "Handle the display of all dictionaries existing on the server." (dictionary-pre-buffer) (insert "Please select your default dictionary:\n\n") @@ -1171,7 +1171,7 @@ allows editing it." ;; if called by pressing the button (unless word (setq word (read-string "Search word: " nil 'dictionary-word-history))) - ;; just in case non-interactivly called + ;; just in case non-interactively called (unless dictionary (setq dictionary dictionary-default-dictionary)) (dictionary-new-search (cons word dictionary))) @@ -1249,10 +1249,10 @@ allows editing it." ;;; Tooltip support -;; Add a mode indicater named "Dict" +;; Add a mode indicator named "Dict" (defvar dictionary-tooltip-mode nil - "Indicates wheather the dictionary tooltip mode is active.") + "Indicates whether the dictionary tooltip mode is active.") (nconc minor-mode-alist '((dictionary-tooltip-mode " Dict"))) (defcustom dictionary-tooltip-dictionary diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el index 66a684dfc59..b07016c1229 100644 --- a/lisp/net/eudcb-macos-contacts.el +++ b/lisp/net/eudcb-macos-contacts.el @@ -108,7 +108,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to (defun eudc-macos-contacts-set-server (dummy) "Set the EUDC server to macOS Contacts app. The server in DUMMY is not actually used, since this backend -always and implicitly connetcs to an instance of the Contacts app +always and implicitly connects to an instance of the Contacts app running on the local host." (interactive) (eudc-set-server dummy 'macos-contacts) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index b95cd0febcd..3097c9a671e 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -332,7 +332,7 @@ whose car is a symbol, it is `eval'uated to yield the validity. If it is a string or list of strings, it represents a shell command to run to return a true or false shell value for the validity. -The last matching entry in this structure takes presedence over +The last matching entry in this structure takes precedence over preceding entries.") (put 'mailcap-mime-data 'risky-local-variable t) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4519c34d36e..69359553e44 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1928,7 +1928,7 @@ If ARGUMENT is non-nil, use it as argument for ;; Check whether we still have the same smbclient version. ;; Otherwise, we must delete the connection cache, because - ;; capabilities migh have changed. + ;; capabilities might have changed. (unless (or argument (processp p)) (let ((default-directory (tramp-compat-temporary-file-directory)) (command (concat tramp-smb-program " -V"))) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 0602943db20..1bc905cee2d 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -546,7 +546,7 @@ Many aspects this mode can be customized using (when (and nxml-default-buffer-file-coding-system (not (local-variable-p 'buffer-file-coding-system))) (setq buffer-file-coding-system nxml-default-buffer-file-coding-system)) - ;; When starting a new file, insert the XML declaraction. + ;; When starting a new file, insert the XML declaration. (when (and nxml-auto-insert-xml-declaration-flag (zerop (buffer-size))) (nxml-insert-xml-declaration))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 484624b8664..9038c7bd95a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -2665,7 +2665,7 @@ comment at the start of cc-engine.el for more info." ;; One of the above "near" caches is associated with each of these functions. ;; ;; When searching this cache, these functions first seek an exact match, then -;; a "close" match from the assiciated near cache. If neither of these +;; a "close" match from the associated near cache. If neither of these ;; succeed, the nearest preceding entry in the far cache is used. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 44a75269524..d01bd3a48ef 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1764,12 +1764,12 @@ or as help on variables `cperl-tips', `cperl-problems', (setq-local syntax-propertize-function (lambda (start end) (goto-char start) - ;; Even if cperl-fontify-syntaxically has already gone + ;; Even if cperl-fontify-syntactically has already gone ;; beyond `start', syntax-propertize has just removed ;; syntax-table properties between start and end, so we have ;; to re-apply them. (setq cperl-syntax-done-to start) - (cperl-fontify-syntaxically end)))) + (cperl-fontify-syntactically end)))) (setq cperl-font-lock-multiline t) ; Not localized... (setq-local font-lock-multiline t) (setq-local font-lock-fontify-region-function @@ -8407,7 +8407,7 @@ do extra unwind via `cperl-unwind-to-safe'." (setq end (point))) (font-lock-default-fontify-region beg end loudly)) -(defun cperl-fontify-syntaxically (end) +(defun cperl-fontify-syntactically (end) ;; Some vars for debugging only ;; (message "Syntaxifying...") (let ((dbg (point)) (iend end) (idone cperl-syntax-done-to) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index b8c8a827eed..d01803282aa 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -483,7 +483,7 @@ Currently, Flymake may provide these keyword-value pairs: * `:recent-changes', a list of recent changes since the last time the backend function was called for the buffer. An empty list - indicates that no changes have been reocrded. If it is the + indicates that no changes have been recorded. If it is the first time that this backend function is called for this activation of `flymake-mode', then this argument isn't provided at all (i.e. it's not merely nil). diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index f934ef7a80e..55c04e13323 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -134,7 +134,7 @@ (interactive) (message "Using verilog-mode version %s" verilog-mode-version)) -(defmacro verilog--supressed-warnings (warnings &rest body) +(defmacro verilog--suppressed-warnings (warnings &rest body) (declare (indent 1) (debug t)) (cond ((fboundp 'with-suppressed-warnings) @@ -5550,7 +5550,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." ;; font-lock-fontify-buffer, but IIUC the problem this is supposed to ;; solve only appears in Emacsen older than font-lock-ensure anyway. (when fontlocked - (verilog--supressed-warnings + (verilog--suppressed-warnings ((interactive-only font-lock-fontify-buffer)) (font-lock-fontify-buffer)))))))) diff --git a/lisp/simple.el b/lisp/simple.el index d6ccdad9021..a4da3f58a99 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -549,7 +549,7 @@ It must be called via `run-hook-with-args-until-success' with no arguments. If any function on this hook returns a non-nil value, `delete-selection-mode' will act on that value (see `delete-selection-helper') and will usually delete the region. If all the functions on this hook return -nil, it is an indiction that `self-insert-command' needs the region +nil, it is an indication that `self-insert-command' needs the region untouched by `delete-selection-mode' and will itself do whatever is appropriate with the region. Any function on `post-self-insert-hook' that acts on the region should diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index a22cd97b309..301f7017e41 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -3327,7 +3327,7 @@ Use `bibtex-summary-function' to generate summary." (message "%s %s" key summary)))))) (defun bibtex-copy-summary-as-kill (&optional arg) - "Push summery of current BibTeX entry to kill ring. + "Push summary of current BibTeX entry to kill ring. Use `bibtex-summary-function' to generate summary. If prefix ARG is non-nil push BibTeX entry's URL to kill ring that is generated by calling `bibtex-url'." diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index ea35641a6c6..04778ee94d4 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -1033,7 +1033,7 @@ However, there does not need to be a title field." (save-excursion ;; `master-menu-inserted-p' is a kludge to tell - ;; whether to insert @end detailmenu (see bleow) + ;; whether to insert @end detailmenu (see below) (let (master-menu-inserted-p) ;; Handle top of menu (insert "\n@menu\n") diff --git a/src/dispnew.c b/src/dispnew.c index e603c671363..b3e4587250f 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3328,7 +3328,7 @@ update_frame_with_menu (struct frame *f, int row, int col) } /* Update the mouse position for a frame F. This handles both - updating the display for mouse-face propreties and updating the + updating the display for mouse-face properties and updating the help echo text. Returns the number of events generated. */ diff --git a/src/font.c b/src/font.c index a59ebe216b8..7c1d1ff89b1 100644 --- a/src/font.c +++ b/src/font.c @@ -4122,7 +4122,7 @@ representing the OpenType features supported by the font by this form: SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType Layout tags. -In addition to the keys listed abobe, the following keys are reserved +In addition to the keys listed above, the following keys are reserved for the specific meanings as below: The value of :combining-capability is non-nil if the font-backend of diff --git a/src/indent.c b/src/indent.c index 0a6b460f753..6246b544fbd 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1315,7 +1315,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, j ^---- next after the point ^--- next char. after the point. ---------- - In case of sigle-column character + In case of single-column character ---------- abcdefgh\\ diff --git a/src/process.c b/src/process.c index 3beb9cf7146..b98bc297a3f 100644 --- a/src/process.c +++ b/src/process.c @@ -8255,7 +8255,7 @@ init_process_emacs (int sockfd) private SIGCHLD handler, allowing catch_child_signal to copy it into lib_child_handler. - Unfortunatly in glib commit 2e471acf, the behavior changed to + Unfortunately in glib commit 2e471acf, the behavior changed to always install a signal handler when g_child_watch_source_new is called and not just the first time it's called. Glib also now resets signal handlers to SIG_DFL when it no longer has a diff --git a/src/w32fns.c b/src/w32fns.c index 86c3db64e7b..9db367bfafe 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -3893,7 +3893,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam, Essentially, we have no information about the "role" of modifiers on this key: which contribute into the produced character (so "are consumed"), and which are - "extra" (must attache to bindable events). + "extra" (must attach to bindable events). The default above would consume ALL modifiers, so the character is reported "as is". However, on many layouts diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el index ea340c370d1..92306d1c7e5 100644 --- a/test/lisp/jsonrpc-tests.el +++ b/test/lisp/jsonrpc-tests.el @@ -244,7 +244,7 @@ :timeout 1) ;; Wait another 0.5 secs just in case the success handlers of ;; one of these last two requests didn't quite have a chance to - ;; run (Emacs 25.2 apparentely needs this). + ;; run (Emacs 25.2 apparently needs this). (accept-process-output nil 0.5) (should second-deferred-went-through-p) (should (eq 1 n-deferred-1)) From 5977de581cbffb18f1cacb266928329dc807cb22 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Feb 2021 11:15:13 -0500 Subject: [PATCH 276/297] * lisp/emacs-lisp/bindat.el: Tweak example in comment Suggested by Kim Storm . --- lisp/emacs-lisp/bindat.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 1f5022c2743..b1b2144e3de 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -41,23 +41,23 @@ ;; Consider the following C structures: ;; ;; struct header { -;; unsigned long dest_ip; -;; unsigned long src_ip; -;; unsigned short dest_port; -;; unsigned short src_port; +;; uint32_t dest_ip; +;; uint32_t src_ip; +;; uint16_t dest_port; +;; uint16_t src_port; ;; }; ;; ;; struct data { -;; unsigned char type; -;; unsigned char opcode; -;; unsigned long length; /* In little endian order */ +;; uint8_t type; +;; uint8_t opcode; +;; uint32_t length; /* In little endian order */ ;; unsigned char id[8]; /* nul-terminated string */ ;; unsigned char data[/* (length + 3) & ~3 */]; ;; }; ;; ;; struct packet { ;; struct header header; -;; unsigned char items; +;; uint8_t items; ;; unsigned char filler[3]; ;; struct data item[/* items */]; ;; }; @@ -75,7 +75,7 @@ ;; (bindat-spec ;; (type u8) ;; (opcode u8) -;; (length u16r) ;; little endian order +;; (length u32r) ;; little endian order ;; (id strz 8) ;; (data vec (length)) ;; (align 4))) From 32e790f2514154c72927c414f43c3e277b1344ac Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 18 Feb 2021 18:05:38 -0500 Subject: [PATCH 277/297] Implement NTLM server for ntlm.el testing * test/Makefile.in (GNU_ELPA_DIRECTORY, elpa_dependencies, elpa_els, elpa_opts): New variables. (EMACSOPT, ert_opts): Add elpa_opts. * test/README: Document GNU_ELPA_DIRECTORY make variable. * test/lisp/net/ntlm-tests.el: Fix checkdoc-reported issues. (ntlm-tests-message, ntlm-server-build-type-2, ntlm-server-hash) (ntlm-server-check-authorization, ntlm-server-do-token) (ntlm-server-filter, ntlm-server-handler, ntlm-server-start) (ntlm-server-stop, ntlm-tests--url-retrieve-internal-around) (ntlm-tests--authenticate) (ntlm-tests--start-server-authenticate-stop-server): New functions. (ntlm-tests--username-oem, ntlm-tests--username-unicode) (ntlm-tests--client-supports-unicode, ntlm-tests--challenge) (ntlm-tests--result-buffer, ntlm-tests--successful-result): New variables. (ntlm-authentication) (ntlm-authentication-old-compatibility-level): New tests. * test/lisp/net/ntlm-resources/authinfo: New file. (Bug#43566) --- test/Makefile.in | 13 +- test/README | 5 + test/lisp/net/ntlm-resources/authinfo | 1 + test/lisp/net/ntlm-tests.el | 360 ++++++++++++++++++++++++++ 4 files changed, 377 insertions(+), 2 deletions(-) create mode 100644 test/lisp/net/ntlm-resources/authinfo diff --git a/test/Makefile.in b/test/Makefile.in index f907602a622..ff228d1261e 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -71,6 +71,15 @@ am__v_at_0 = @ am__v_at_1 = +# Load any GNU ELPA dependencies that are present, for optional tests. +GNU_ELPA_DIRECTORY ?= $(srcdir)/../../elpa +# Keep elpa_dependencies dependency-ordered. +elpa_dependencies = \ + url-http-ntlm/url-http-ntlm.el \ + web-server/web-server.el +elpa_els = $(addprefix $(GNU_ELPA_DIRECTORY)/packages/,$(elpa_dependencies)) +elpa_opts = $(foreach el,$(elpa_els),$(and $(wildcard $(el)),-L $(dir $(el)) -l $(el))) + # We never change directory before running Emacs, so a relative file # name is fine, and makes life easier. If we need to change # directory, we can use emacs --chdir. @@ -81,7 +90,7 @@ EMACS_EXTRAOPT= # Command line flags for Emacs. # Apparently MSYS bash would convert "-L :" to "-L ;" anyway, # but we might as well be explicit. -EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT) +EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(elpa_opts) $(EMACS_EXTRAOPT) # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS @@ -105,7 +114,7 @@ export TEST_LOAD_EL ?= \ $(if $(findstring $(MAKECMDGOALS), all check check-maybe),no,yes) # Additional settings for ert. -ert_opts = +ert_opts += $(elpa_opts) # Maximum length of lines in ert backtraces; nil for no limit. # (if empty, use the default ert-batch-backtrace-right-margin). diff --git a/test/README b/test/README index 5f3c10adbe1..877f77ab947 100644 --- a/test/README +++ b/test/README @@ -108,6 +108,11 @@ to a suitable value in order to overwrite the default value: env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ... +Some optional tests require packages from GNU ELPA. By default +../../elpa will be checked for these packages. If GNU ELPA is checked +out somewhere else, use + + make GNU_ELPA_DIRECTORY=/path/to/elpa ... There are also continuous integration tests on (see diff --git a/test/lisp/net/ntlm-resources/authinfo b/test/lisp/net/ntlm-resources/authinfo new file mode 100644 index 00000000000..698391e9313 --- /dev/null +++ b/test/lisp/net/ntlm-resources/authinfo @@ -0,0 +1 @@ +machine localhost port http user ntlm password ntlm diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el index 6408ac13349..0ed430afe68 100644 --- a/test/lisp/net/ntlm-tests.el +++ b/test/lisp/net/ntlm-tests.el @@ -17,11 +17,26 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . +;;; Commentary: + +;; Run this with `NTLM_TESTS_VERBOSE=1' to get verbose debugging. + +;;; Code: + (require 'ert) +(require 'ert-x) (require 'ntlm) +(defsubst ntlm-tests-message (format-string &rest arguments) + "Print a message conditional on an environment variable being set. +FORMAT-STRING and ARGUMENTS are passed to the message function." + (when (getenv "NTLM_TESTS_VERBOSE") + (apply #'message (concat "ntlm-tests: " format-string) arguments))) + + ;; This is the Lisp bignum implementation of `ntlm--time-to-timestamp', ;; for reference. + (defun ntlm-tests--time-to-timestamp (time) "Convert TIME to an NTLMv2 timestamp. Return a unibyte string representing the number of tenths of a @@ -49,4 +64,349 @@ signed integer. TIME must be on the form (HIGH LOW USEC PSEC)." (should (equal (ntlm--time-to-timestamp time) (ntlm-tests--time-to-timestamp time))))) +(defvar ntlm-tests--username-oem "ntlm" + "The username for NTLM authentication tests, in OEM string encoding.") +(defvar ntlm-tests--username-unicode + (ntlm-ascii2unicode ntlm-tests--username-oem + (length ntlm-tests--username-oem)) + "The username for NTLM authentication tests, in Unicode string encoding.") + +(defvar ntlm-tests--password "ntlm" + "The password used for NTLM authentication tests.") + +(defvar ntlm-tests--client-supports-unicode nil + "Non-nil if client supports Unicode strings. +If client only supports OEM strings, nil.") + +(defvar ntlm-tests--challenge nil "The global random challenge.") + +(defun ntlm-server-build-type-2 () + "Return an NTLM Type 2 message as a string. +This string will be returned from the NTLM server to the NTLM client." + (let ((target (if ntlm-tests--client-supports-unicode + (ntlm-ascii2unicode "DOMAIN" (length "DOMAIN")) + "DOMAIN")) + (target-information ntlm-tests--password) + ;; Flag byte 1 flags. + (_negotiate-unicode 1) + (negotiate-oem 2) + (request-target 4) + ;; Flag byte 2 flags. + (negotiate-ntlm 2) + (_negotiate-local-call 4) + (_negotiate-always-sign 8) + ;; Flag byte 3 flags. + (_target-type-domain 1) + (_target-type-server 2) + (target-type-share 4) + (_negotiate-ntlm2-key 8) + (negotiate-target-information 128) + ;; Flag byte 4 flags, unused. + (_negotiate-128 32) + (_negotiate-56 128)) + (concat + ;; Signature. + "NTLMSSP" (unibyte-string 0) + ;; Type 2. + (unibyte-string 2 0 0 0) + ;; Target length + (unibyte-string (length target) 0) + ;; Target allocated space. + (unibyte-string (length target) 0) + ;; Target offset. + (unibyte-string 48 0 0 0) + ;; Flags. + ;; Flag byte 1. + ;; Tell the client that this test server only supports OEM + ;; strings. This test server will handle Unicode strings + ;; anyway though. + (unibyte-string (logior negotiate-oem request-target)) + ;; Flag byte 2. + (unibyte-string negotiate-ntlm) + ;; Flag byte 3. + (unibyte-string (logior negotiate-target-information target-type-share)) + ;; Flag byte 4. Not sure what 2 means here. + (unibyte-string 2) + ;; Challenge. Set this to (unibyte-string 1 2 3 4 5 6 7 8) + ;; instead of (ntlm-generate-nonce) to hold constant for + ;; debugging. + (setq ntlm-tests--challenge (ntlm-generate-nonce)) + ;; Context. + (make-string 8 0) + (unibyte-string (length target-information) 0) + (unibyte-string (length target-information) 0) + (unibyte-string 54 0 0 0) + target + target-information))) + +(defun ntlm-server-hash (challenge blob username password) + "Hash CHALLENGE, BLOB, USERNAME and PASSWORD for a Type 3 check." + (hmac-md5 (concat challenge blob) + (hmac-md5 (concat + (upcase + ;; This calculation always uses + ;; Unicode username, even when the + ;; server only supports OEM strings. + (ntlm-ascii2unicode username (length username))) "") + (cadr (ntlm-get-password-hashes password))))) + +(defun ntlm-server-check-authorization (authorization-string) + "Return t if AUTHORIZATION-STRING correctly authenticates the user." + (let* ((binary (base64-decode-string + (caddr (split-string authorization-string " ")))) + (_lm-response-length (md4-unpack-int16 (substring binary 12 14))) + (_lm-response-offset + (cdr (md4-unpack-int32 (substring binary 16 20)))) + (ntlm-response-length (md4-unpack-int16 (substring binary 20 22))) + (ntlm-response-offset + (cdr (md4-unpack-int32 (substring binary 24 28)))) + (ntlm-hash + (substring binary ntlm-response-offset (+ ntlm-response-offset 16))) + (username-length (md4-unpack-int16 (substring binary 36 38))) + (username-offset (cdr (md4-unpack-int32 (substring binary 40 44)))) + (username (substring binary username-offset + (+ username-offset username-length)))) + (if (equal ntlm-response-length 24) + (let* ((expected + (ntlm-smb-owf-encrypt + (cadr (ntlm-get-password-hashes ntlm-tests--password)) + ntlm-tests--challenge)) + (received (substring binary ntlm-response-offset + (+ ntlm-response-offset + ntlm-response-length)))) + (ntlm-tests-message "Got NTLMv1 response:") + (ntlm-tests-message "Expected hash: ===%S===" expected) + (ntlm-tests-message "Got hash: ===%S===" received) + (ntlm-tests-message "Expected username: ===%S===" + ntlm-tests--username-oem) + (ntlm-tests-message "Got username: ===%S===" username) + (and (or (equal username ntlm-tests--username-oem) + (equal username ntlm-tests--username-unicode)) + (equal expected received))) + (let* ((ntlm-response-blob + (substring binary (+ ntlm-response-offset 16) + (+ (+ ntlm-response-offset 16) + (- ntlm-response-length 16)))) + (_ntlm-timestamp (substring ntlm-response-blob 8 16)) + (_ntlm-nonce (substring ntlm-response-blob 16 24)) + (_target-length (md4-unpack-int16 (substring binary 28 30))) + (_target-offset + (cdr (md4-unpack-int32 (substring binary 32 36)))) + (_workstation-length (md4-unpack-int16 (substring binary 44 46))) + (_workstation-offset + (cdr (md4-unpack-int32 (substring binary 48 52))))) + (cond + ;; This test server claims to only support OEM strings, + ;; but also checks Unicode strings. + ((or (equal username ntlm-tests--username-oem) + (equal username ntlm-tests--username-unicode)) + (let* ((password ntlm-tests--password) + (ntlm-hash-from-type-3 (ntlm-server-hash + ntlm-tests--challenge + ntlm-response-blob + ;; Always -oem since + ;; `ntlm-server-hash' + ;; always converts it to + ;; Unicode. + ntlm-tests--username-oem + password))) + (ntlm-tests-message "Got NTLMv2 response:") + (ntlm-tests-message "Expected hash: ==%S==" ntlm-hash) + (ntlm-tests-message "Got hash: ==%S==" ntlm-hash-from-type-3) + (ntlm-tests-message "Expected username: ===%S===" + ntlm-tests--username-oem) + (ntlm-tests-message " or username: ===%S===" + ntlm-tests--username-unicode) + (ntlm-tests-message "Got username: ===%S===" username) + (equal ntlm-hash ntlm-hash-from-type-3))) + (t + nil)))))) + +(require 'eieio) +(require 'cl-lib) + +;; Silence some byte-compiler warnings that occur when +;; web-server/web-server.el is not found. +(declare-function ws-send nil) +(declare-function ws-parse-request nil) +(declare-function ws-start nil) +(declare-function ws-stop-all nil) + +(require 'web-server nil t) +(require 'url-http-ntlm nil t) + +(defun ntlm-server-do-token (request _process) + "Process an NTLM client's REQUEST. +PROCESS is unused." + (with-slots (process headers) request + (let* ((header-alist (cdr headers)) + (authorization-header (assoc ':AUTHORIZATION header-alist)) + (authorization-string (cdr authorization-header))) + (if (and (stringp authorization-string) + (string-match "NTLM " authorization-string)) + (let* ((challenge (substring authorization-string (match-end 0))) + (binary (base64-decode-string challenge)) + (type (aref binary 8)) + ;; Flag byte 1 flags. + (negotiate-unicode 1) + (negotiate-oem 2) + (flags-byte-1 (aref binary 12)) + (client-supports-unicode + (not (zerop (logand flags-byte-1 negotiate-unicode)))) + (client-supports-oem + (not (zerop (logand flags-byte-1 negotiate-oem)))) + (connection-header (assoc ':CONNECTION header-alist)) + (_keep-alive + (when connection-header (cdr connection-header))) + (response + (cl-case type + (1 + ;; Return Type 2 message. + (when (and (not client-supports-unicode) + (not client-supports-oem)) + (warn (concat + "Weird client supports neither Unicode" + " nor OEM strings, using OEM."))) + (setq ntlm-tests--client-supports-unicode + client-supports-unicode) + (concat + "HTTP/1.1 401 Unauthorized\r\n" + "WWW-Authenticate: NTLM " + (base64-encode-string + (ntlm-server-build-type-2) t) "\r\n" + "WWW-Authenticate: Negotiate\r\n" + "WWW-Authenticate: Basic realm=\"domain\"\r\n" + "Content-Length: 0\r\n\r\n")) + (3 + (if (ntlm-server-check-authorization + authorization-string) + "HTTP/1.1 200 OK\r\n\r\nAuthenticated.\r\n" + (progn + (if process + (set-process-filter process nil) + (error "Type 3 message found first?")) + (concat "HTTP/1.1 401 Unauthorized\r\n\r\n" + "Access Denied.\r\n"))))))) + (if response + (ws-send process response) + (when process + (set-process-filter process nil))) + (when (equal type 3) + (set-process-filter process nil) + (process-send-eof process))) + (progn + ;; Did not get NTLM anything. + (set-process-filter process nil) + (process-send-eof process) + (concat "HTTP/1.1 401 Unauthorized\r\n\r\n" + "Access Denied.\r\n")))))) + +(defun ntlm-server-filter (process string) + "Read from PROCESS a STRING and treat it as a request from an NTLM client." + (let ((request (make-instance 'ws-request + :process process :pending string))) + (if (ws-parse-request request) + (ntlm-server-do-token request process) + (error "Failed to parse request")))) + +(defun ntlm-server-handler (request) + "Handle an HTTP REQUEST." + (with-slots (process headers) request + (let* ((header-alist (cdr headers)) + (authorization-header (assoc ':AUTHORIZATION header-alist)) + (connection-header (assoc ':CONNECTION header-alist)) + (keep-alive (when connection-header (cdr connection-header))) + (response (concat + "HTTP/1.1 401 Unauthorized\r\n" + "WWW-Authenticate: Negotiate\r\n" + "WWW-Authenticate: NTLM\r\n" + "WWW-Authenticate: Basic realm=\"domain\"\r\n" + "Content-Length: 0\r\n\r\n"))) + (if (null authorization-header) + ;; Tell client to use NTLM. Firefox will create a new + ;; connection. + (progn + (process-send-string process response) + (process-send-eof process)) + (progn + (ntlm-server-do-token request nil) + (set-process-filter process #'ntlm-server-filter) + (if (equal (upcase keep-alive) "KEEP-ALIVE") + :keep-alive + (error "NTLM server expects keep-alive connection header"))))))) + +(defun ntlm-server-start () + "Start an NTLM server on port 8080 for testing." + (ws-start 'ntlm-server-handler 8080)) + +(defun ntlm-server-stop () + "Stop the NTLM server." + (ws-stop-all)) + +(defvar ntlm-tests--result-buffer nil "Final NTLM result buffer.") + +(require 'url) + +(defun ntlm-tests--url-retrieve-internal-around (original &rest arguments) + "Save the result buffer from a `url-retrieve-internal' to a global variable. +ORIGINAL is the original `url-retrieve-internal' function and +ARGUMENTS are passed to it." + (setq ntlm-tests--result-buffer (apply original arguments))) + +(defun ntlm-tests--authenticate () + "Authenticate using credentials from the authinfo resource file." + (setq ntlm-tests--result-buffer nil) + (let ((auth-sources (list (ert-resource-file "authinfo"))) + (auth-source-do-cache nil) + (auth-source-debug (when (getenv "NTLM_TESTS_VERBOSE") 'trivia))) + (ntlm-tests-message "Using auth-sources: %S" auth-sources) + (url-retrieve-synchronously "http://localhost:8080")) + (sleep-for 0.1) + (ntlm-tests-message "Results are in: %S" ntlm-tests--result-buffer) + (with-current-buffer ntlm-tests--result-buffer + (buffer-string))) + +(defun ntlm-tests--start-server-authenticate-stop-server () + "Start an NTLM server, authenticate against it, then stop the server." + (advice-add #'url-retrieve-internal + :around #'ntlm-tests--url-retrieve-internal-around) + (ntlm-server-stop) + (ntlm-server-start) + (let ((result (ntlm-tests--authenticate))) + (advice-remove #'url-retrieve-internal + #'ntlm-tests--url-retrieve-internal-around) + (ntlm-server-stop) + result)) + +(defvar ntlm-tests--successful-result + (concat "HTTP/1.1 200 OK\n\nAuthenticated." (unibyte-string 13) "\n") + "Expected result of successful NTLM authentication.") + +(defvar ntlm-tests--dependencies-present + (and (featurep 'url-http-ntlm) (featurep 'web-server)) + "Non-nil if GNU ELPA test dependencies were loaded.") + +(when (not ntlm-tests--dependencies-present) + (warn "Cannot find one or more GNU ELPA packages") + (when (not (featurep 'url-http-ntlm)) + (warn "Need url-http-ntlm/url-http-ntlm.el")) + (when (not (featurep 'web-server)) + (warn "Need web-server/web-server.el")) + (warn "Skipping NTLM authentication tests") + (warn "See GNU_ELPA_DIRECTORY in test/README")) + +(ert-deftest ntlm-authentication () + "Check ntlm.el's implementation of NTLM authentication over HTTP." + (skip-unless ntlm-tests--dependencies-present) + (should (equal (ntlm-tests--start-server-authenticate-stop-server) + ntlm-tests--successful-result))) + +(ert-deftest ntlm-authentication-old-compatibility-level () + (skip-unless ntlm-tests--dependencies-present) + (setq ntlm-compatibility-level 0) + (should (equal (ntlm-tests--start-server-authenticate-stop-server) + ntlm-tests--successful-result))) + (provide 'ntlm-tests) + +;;; ntlm-tests.el ends here From 7467dc4f181f2bf9adc3335afab9fb7ee909a60d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 02:27:56 +0100 Subject: [PATCH 278/297] Do interactive mode tagging for package.el --- lisp/emacs-lisp/package.el | 53 ++++++++++++++++++++++---------------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 90b7b88d58a..092befa1f2e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2802,6 +2802,7 @@ either a full name or nil, and EMAIL is a valid email address." Letters do not insert themselves; instead, they are commands. \\ \\{package-menu-mode-map}" + :interactive nil (setq mode-line-process '((package--downloads-in-progress ":Loading") (package-menu--transaction-status package-menu--transaction-status))) @@ -2924,7 +2925,7 @@ Installed obsolete packages are always displayed.") Also hide packages whose name matches a regexp in user option `package-hidden-regexps' (a list). To add regexps to this list, use `package-menu-hide-package'." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (setq package-menu--hide-packages (not package-menu--hide-packages)) @@ -3261,7 +3262,7 @@ To unhide a package, type Type \\[package-menu-toggle-hiding] to toggle package hiding." (declare (interactive-only "change `package-hidden-regexps' instead.")) - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (let* ((name (when (derived-mode-p 'package-menu-mode) (concat "\\`" (regexp-quote (symbol-name (package-desc-name @@ -3285,7 +3286,7 @@ Type \\[package-menu-toggle-hiding] to toggle package hiding." (defun package-menu-describe-package (&optional button) "Describe the current package. If optional arg BUTTON is non-nil, describe its associated package." - (interactive) + (interactive nil package-menu-mode) (let ((pkg-desc (if button (button-get button 'package-desc) (tabulated-list-get-id)))) (if pkg-desc @@ -3295,7 +3296,7 @@ If optional arg BUTTON is non-nil, describe its associated package." ;; fixme numeric argument (defun package-menu-mark-delete (&optional _num) "Mark a package for deletion and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (if (member (package-menu-get-status) '("installed" "dependency" "obsolete" "unsigned")) @@ -3304,7 +3305,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-mark-install (&optional _num) "Mark a package for installation and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency")) (tabulated-list-put-tag "I" t) @@ -3312,20 +3313,20 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-mark-unmark (&optional _num) "Clear any marks on a package and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (tabulated-list-put-tag " " t)) (defun package-menu-backup-unmark () "Back up one line and clear any marks on that package." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (forward-line -1) (tabulated-list-put-tag " ")) (defun package-menu-mark-obsolete-for-deletion () "Mark all obsolete packages for deletion." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (save-excursion (goto-char (point-min)) @@ -3356,7 +3357,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-quick-help () "Show short key binding help for `package-menu-mode'. The full list of keys can be viewed with \\[describe-mode]." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (message (mapconcat #'package--prettify-quick-help-key package--quick-help-keys "\n"))) @@ -3452,7 +3453,7 @@ call will upgrade the package. If there's an async refresh operation in progress, the flags will be placed as part of `package-menu--post-refresh' instead of immediately." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (if (not package--downloads-in-progress) (package-menu--mark-upgrades-1) @@ -3546,7 +3547,7 @@ packages list, respectively." Packages marked for installation are downloaded and installed; packages marked for deletion are removed. Optional argument NOQUERY non-nil means do not ask the user to confirm." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (let (install-list delete-list cmd pkg-desc) (save-excursion @@ -3791,7 +3792,8 @@ strings. If ARCHIVE is nil or the empty string, show all packages." (interactive (list (completing-read-multiple "Filter by archive (comma separated): " - (mapcar #'car package-archives)))) + (mapcar #'car package-archives))) + package-menu-mode) (package--ensure-package-menu-mode) (let ((re (if (listp archive) (regexp-opt archive) @@ -3812,7 +3814,8 @@ DESCRIPTION. When called interactively, prompt for DESCRIPTION. If DESCRIPTION is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by description (regexp)"))) + (interactive (list (read-regexp "Filter by description (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not description) (string-empty-p description)) (package-menu--generate t t) @@ -3833,10 +3836,11 @@ strings. If KEYWORD is nil or the empty string, show all packages." (interactive (list (completing-read-multiple "Keywords (comma separated): " - (package-all-keywords)))) + (package-all-keywords))) + package-menu-mode) + (package--ensure-package-menu-mode) (when (stringp keyword) (setq keyword (list keyword))) - (package--ensure-package-menu-mode) (if (not keyword) (package-menu--generate t t) (package-menu--filter-by (lambda (pkg-desc) @@ -3855,7 +3859,8 @@ When called interactively, prompt for NAME-OR-DESCRIPTION. If NAME-OR-DESCRIPTION is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by name or description (regexp)"))) + (interactive (list (read-regexp "Filter by name or description (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not name-or-description) (string-empty-p name-or-description)) (package-menu--generate t t) @@ -3874,7 +3879,8 @@ Display only packages with name that matches regexp NAME. When called interactively, prompt for NAME. If NAME is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by name (regexp)"))) + (interactive (list (read-regexp "Filter by name (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not name) (string-empty-p name)) (package-menu--generate t t) @@ -3904,7 +3910,8 @@ packages." "incompat" "installed" "new" - "unsigned")))) + "unsigned"))) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not status) (string-empty-p status)) (package-menu--generate t t) @@ -3939,7 +3946,9 @@ If VERSION is nil or the empty string, show all packages." ('< "< less than") ('> "> greater than")) "): ")) - choice)))) + choice))) + package-menu-mode) + (package--ensure-package-menu-mode) (unless (equal predicate 'quit) (if (or (not version) (string-empty-p version)) (package-menu--generate t t) @@ -3957,7 +3966,7 @@ If VERSION is nil or the empty string, show all packages." (defun package-menu-filter-marked () "Filter \"*Packages*\" buffer by non-empty upgrade mark. Unlike other filters, this leaves the marks intact." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (widen) (let (found-entries mark pkg-id entry marks) @@ -3985,7 +3994,7 @@ Unlike other filters, this leaves the marks intact." (defun package-menu-filter-upgradable () "Filter \"*Packages*\" buffer to show only upgradable packages." - (interactive) + (interactive nil package-menu-mode) (let ((pkgs (mapcar #'car (package-menu--find-upgrades)))) (package-menu--filter-by (lambda (pkg) @@ -3994,7 +4003,7 @@ Unlike other filters, this leaves the marks intact." (defun package-menu-clear-filter () "Clear any filter currently applied to the \"*Packages*\" buffer." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (package-menu--generate t t)) From 388a87432b5e95544d6d74252ea531e64d6495a5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 06:29:00 +0100 Subject: [PATCH 279/297] Do interactive mode tagging for man.el --- lisp/man.el | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/lisp/man.el b/lisp/man.el index 1fded38e72d..70b8aa8eb2f 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1024,7 +1024,7 @@ to auto-complete your input based on the installed manual pages." ;;;###autoload (defun man-follow (man-args) "Get a Un*x manual page of the item under point and put it in a buffer." - (interactive (list (Man-default-man-entry))) + (interactive (list (Man-default-man-entry)) Man-mode) (if (or (not man-args) (string= man-args "")) (error "No item under point") @@ -1143,7 +1143,7 @@ Return the buffer in which the manpage will appear." (defun Man-update-manpage () "Reformat current manpage by calling the man command again synchronously." - (interactive) + (interactive nil Man-mode) (when (eq Man-arguments nil) ;;this shouldn't happen unless it is not in a Man buffer." (error "Man-arguments not initialized")) @@ -1239,7 +1239,7 @@ See the variable `Man-notify-method' for the different notification behaviors." (defun Man-fontify-manpage () "Convert overstriking and underlining to the correct fonts. Same for the ANSI bold and normal escape sequences." - (interactive) + (interactive nil Man-mode) (goto-char (point-min)) ;; Fontify ANSI escapes. (let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face) @@ -1355,7 +1355,7 @@ default type, `Man-xref-man-page' is used for the buttons." Normally skip any jobs that should have been done by the sed script, but when called interactively, do those jobs even if the sed script would have done them." - (interactive "p") + (interactive "p" Man-mode) (if (or interactive (not Man-sed-script)) (progn (goto-char (point-min)) @@ -1723,7 +1723,7 @@ The following key bindings are currently in effect in the buffer: (defun Man-next-section (n) "Move point to Nth next section (default 1)." - (interactive "p") + (interactive "p" Man-mode) (let ((case-fold-search nil) (start (point))) (if (looking-at Man-heading-regexp) @@ -1739,7 +1739,7 @@ The following key bindings are currently in effect in the buffer: (defun Man-previous-section (n) "Move point to Nth previous section (default 1)." - (interactive "p") + (interactive "p" Man-mode) (let ((case-fold-search nil)) (if (looking-at Man-heading-regexp) (forward-line -1)) @@ -1756,8 +1756,7 @@ Returns t if section is found, nil otherwise." (if (re-search-forward (concat "^" section) (point-max) t) (progn (beginning-of-line) t) (goto-char curpos) - nil) - )) + nil))) (defvar Man--last-section nil) @@ -1771,7 +1770,8 @@ Returns t if section is found, nil otherwise." (prompt (concat "Go to section (default " default "): ")) (chosen (completing-read prompt Man--sections nil nil nil nil default))) - (list chosen))) + (list chosen)) + Man-mode) (setq Man--last-section section) (unless (Man-find-section section) (error "Section %s not found" section))) @@ -1780,7 +1780,7 @@ Returns t if section is found, nil otherwise." (defun Man-goto-see-also-section () "Move point to the \"SEE ALSO\" section. Actually the section moved to is described by `Man-see-also-regexp'." - (interactive) + (interactive nil Man-mode) (if (not (Man-find-section Man-see-also-regexp)) (error "%s" (concat "No " Man-see-also-regexp " section found in the current manpage")))) @@ -1834,7 +1834,8 @@ Specify which REFERENCE to use; default is based on word at point." (prompt (concat "Refer to (default " default "): ")) (chosen (completing-read prompt Man--refpages nil nil nil nil defaults))) - chosen)))) + chosen))) + Man-mode) (if (not Man--refpages) (error "Can't find any references in the current manpage") (setq Man--last-refpage reference) @@ -1843,7 +1844,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-kill () "Kill the buffer containing the manpage." - (interactive) + (interactive nil Man-mode) (quit-window t)) (defun Man-goto-page (page &optional noerror) @@ -1854,7 +1855,8 @@ Specify which REFERENCE to use; default is based on word at point." (if (= (length Man-page-list) 1) (error "You're looking at the only manpage in the buffer") (list (read-minibuffer (format "Go to manpage [1-%d]: " - (length Man-page-list))))))) + (length Man-page-list)))))) + Man-mode) (if (and (not Man-page-list) (not noerror)) (error "Not a man page buffer")) (when Man-page-list @@ -1876,7 +1878,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-next-manpage () "Find the next manpage entry in the buffer." - (interactive) + (interactive nil Man-mode) (if (= (length Man-page-list) 1) (error "This is the only manpage in the buffer")) (if (< Man-current-page (length Man-page-list)) @@ -1887,7 +1889,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-previous-manpage () "Find the previous manpage entry in the buffer." - (interactive) + (interactive nil Man-mode) (if (= (length Man-page-list) 1) (error "This is the only manpage in the buffer")) (if (> Man-current-page 1) From 928b643a28919e927af3aba8f8b420e098eb45c4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 06:32:04 +0100 Subject: [PATCH 280/297] Do interactive mode tagging for tetris.el --- lisp/play/tetris.el | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 05e4ffe0111..f43aa47326f 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -506,7 +506,7 @@ Drops the shape one square, testing for collision." (defun tetris-move-bottom () "Drop the shape to the bottom of the playing area." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (let ((hit nil)) (tetris-erase-shape) @@ -519,7 +519,7 @@ Drops the shape one square, testing for collision." (defun tetris-move-left () "Move the shape one square to the left." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-x (1- tetris-pos-x)) @@ -529,7 +529,7 @@ Drops the shape one square, testing for collision." (defun tetris-move-right () "Move the shape one square to the right." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-x (1+ tetris-pos-x)) @@ -539,7 +539,7 @@ Drops the shape one square, testing for collision." (defun tetris-move-down () "Move the shape one square to the bottom." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-y (1+ tetris-pos-y)) @@ -549,7 +549,7 @@ Drops the shape one square, testing for collision." (defun tetris-rotate-prev () "Rotate the shape clockwise." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-rot (% (+ 1 tetris-rot) @@ -561,7 +561,7 @@ Drops the shape one square, testing for collision." (defun tetris-rotate-next () "Rotate the shape anticlockwise." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-rot (% (+ 3 tetris-rot) @@ -573,14 +573,14 @@ Drops the shape one square, testing for collision." (defun tetris-end-game () "Terminate the current game." - (interactive) + (interactive nil tetris-mode) (gamegrid-kill-timer) (use-local-map tetris-null-map) (gamegrid-add-score tetris-score-file tetris-score)) (defun tetris-start-game () "Start a new game of Tetris." - (interactive) + (interactive nil tetris-mode) (tetris-reset-game) (use-local-map tetris-mode-map) (let ((period (or (tetris-get-tick-period) @@ -589,7 +589,7 @@ Drops the shape one square, testing for collision." (defun tetris-pause-game () "Pause (or resume) the current game." - (interactive) + (interactive nil tetris-mode) (setq tetris-paused (not tetris-paused)) (message (and tetris-paused "Game paused (press p to resume)"))) @@ -600,6 +600,7 @@ Drops the shape one square, testing for collision." (define-derived-mode tetris-mode nil "Tetris" "A mode for playing Tetris." + :interactive nil (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) From 73a6ab0a1b5c0f9620b439e13998a08f8214a334 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 06:51:49 +0100 Subject: [PATCH 281/297] Do interactive mode tagging for snake.el --- lisp/play/snake.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp/play/snake.el b/lisp/play/snake.el index bed7cea6ee5..29effa23460 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -336,38 +336,38 @@ Argument SNAKE-BUFFER is the name of the buffer." (defun snake-move-left () "Make the snake move left." - (interactive) + (interactive nil snake-mode) (when (zerop (snake-final-x-velocity)) (push '(-1 0) snake-velocity-queue))) (defun snake-move-right () "Make the snake move right." - (interactive) + (interactive nil snake-mode) (when (zerop (snake-final-x-velocity)) (push '(1 0) snake-velocity-queue))) (defun snake-move-up () "Make the snake move up." - (interactive) + (interactive nil snake-mode) (when (zerop (snake-final-y-velocity)) (push '(0 -1) snake-velocity-queue))) (defun snake-move-down () "Make the snake move down." - (interactive) + (interactive nil snake-mode) (when (zerop (snake-final-y-velocity)) (push '(0 1) snake-velocity-queue))) (defun snake-end-game () "Terminate the current game." - (interactive) + (interactive nil snake-mode) (gamegrid-kill-timer) (use-local-map snake-null-map) (gamegrid-add-score snake-score-file snake-score)) (defun snake-start-game () "Start a new game of Snake." - (interactive) + (interactive nil snake-mode) (snake-reset-game) (snake-set-dot) (use-local-map snake-mode-map) @@ -375,7 +375,7 @@ Argument SNAKE-BUFFER is the name of the buffer." (defun snake-pause-game () "Pause (or resume) the current game." - (interactive) + (interactive nil snake-mode) (setq snake-paused (not snake-paused)) (message (and snake-paused "Game paused (press p to resume)"))) @@ -386,6 +386,7 @@ Argument SNAKE-BUFFER is the name of the buffer." (define-derived-mode snake-mode special-mode "Snake" "A mode for playing Snake." + :interactive nil (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) From 3c7b839e1a2bd8c896892c61f75a9016f52e787b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Feb 2021 09:21:55 +0100 Subject: [PATCH 282/297] Fix Tramp bug#46625 * test/lisp/net/tramp-tests.el (tramp-test33-environment-variables): Adapt test. (Bug#46625) --- test/lisp/net/tramp-tests.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 9a83fa66761..016b4d3c8f0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5102,8 +5102,10 @@ INPUT, if non-nil, is a string sent to the process." (string-match-p (regexp-quote envvar) ;; We must remove PS1, the output is truncated otherwise. + ;; We must suppress "_=VAR...". (funcall - this-shell-command-to-string "printenv | grep -v PS1"))))))))) + this-shell-command-to-string + "printenv | grep -v PS1 | grep -v _="))))))))) (tramp--test--deftest-direct-async-process tramp-test33-environment-variables "Check that remote processes set / unset environment variables properly. From 87669400aff6ecdf670de6368168c5833848d56f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 08:30:04 +0100 Subject: [PATCH 283/297] ; * lisp/plstore.el: Fix formatting. --- lisp/plstore.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/plstore.el b/lisp/plstore.el index 46533664d52..4ca5886bf15 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -1,4 +1,5 @@ ;;; plstore.el --- secure plist store -*- lexical-binding: t -*- + ;; Copyright (C) 2011-2021 Free Software Foundation, Inc. ;; Author: Daiki Ueno @@ -19,7 +20,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;; Commentary +;;; Commentary: ;; Plist based data store providing search and partial encryption. ;; From 9b944f48c9ce65bad50e7c6a957200c0f2d4f1a8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 08:38:29 +0100 Subject: [PATCH 284/297] * lisp/calculator.el: Minor doc fix. Remove redundant :group args. --- lisp/calculator.el | 62 +++++++++++++++------------------------------- 1 file changed, 20 insertions(+), 42 deletions(-) diff --git a/lisp/calculator.el b/lisp/calculator.el index b4c00753e91..00883989b29 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -20,23 +20,18 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;;===================================================================== ;;; Commentary: -;; + ;; A calculator for Emacs. ;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or ;; whatever), when you have Emacs running already? ;; -;; If this is not part of your Emacs distribution, then simply bind -;; `calculator' to a key and make it an autoloaded function, e.g.: -;; (autoload 'calculator "calculator" -;; "Run the Emacs calculator." t) +;; You can bind this to a key by adding this to your Init file: +;; ;; (global-set-key [(control return)] 'calculator) ;; ;; Written by Eli Barzilay, eli@barzilay.org -;; -;;;===================================================================== ;;; Customization: (defgroup calculator nil @@ -50,19 +45,16 @@ "Run `calculator' electrically, in the echo area. Electric mode saves some place but changes the way you interact with the calculator." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-use-menu t "Make `calculator' create a menu. Note that this requires easymenu. Must be set before loading." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-bind-escape nil "If non-nil, set escape to exit the calculator." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-unary-style 'postfix "Value is either `prefix' or `postfix'. @@ -75,44 +67,38 @@ This determines the default behavior of unary operators." It should contain a \"%s\" somewhere that will indicate the i/o radixes; this will be a two-character string as described in the documentation for `calculator-mode'." - :type 'string - :group 'calculator) + :type 'string) (defcustom calculator-number-digits 3 "The calculator's number of digits used for standard display. Used by the `calculator-standard-display' function - it will use the format string \"%.NC\" where this number is N and C is a character given at runtime." - :type 'integer - :group 'calculator) + :type 'integer) (defcustom calculator-radix-grouping-mode t "Use digit grouping in radix output mode. If this is set, chunks of `calculator-radix-grouping-digits' characters will be separated by `calculator-radix-grouping-separator' when in radix output mode is active (determined by `calculator-output-radix')." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-radix-grouping-digits 4 "The number of digits used for grouping display in radix modes. See `calculator-radix-grouping-mode'." - :type 'integer - :group 'calculator) + :type 'integer) (defcustom calculator-radix-grouping-separator "'" "The separator used in radix grouping display. See `calculator-radix-grouping-mode'." - :type 'string - :group 'calculator) + :type 'string) (defcustom calculator-remove-zeros t "Non-nil value means delete all redundant zero decimal digits. If this value is not t and not nil, redundant zeros are removed except for one. Used by the `calculator-remove-zeros' function." - :type '(choice (const t) (const leave-decimal) (const nil)) - :group 'calculator) + :type '(choice (const t) (const leave-decimal) (const nil))) (defcustom calculator-displayer '(std ?n) "A displayer specification for numerical values. @@ -135,8 +121,7 @@ a character and G is an optional boolean, in this case the arguments." :type '(choice (function) (string) (sexp) (list (const std) character) - (list (const std) character boolean)) - :group 'calculator) + (list (const std) character boolean))) (defcustom calculator-displayers '(((std ?n) "Standard display, decimal point or scientific") @@ -152,15 +137,13 @@ specification is the same as the values that can be stored in `calculator-displayer'. `calculator-rotate-displayer' rotates this list." - :type 'sexp - :group 'calculator) + :type 'sexp) (defcustom calculator-paste-decimals t "If non-nil, convert pasted integers so they have a decimal point. This makes it possible to paste big integers since they will be read as floats, otherwise the Emacs reader will fail on them." - :type 'boolean - :group 'calculator) + :type 'boolean) (make-obsolete-variable 'calculator-paste-decimals "it is no longer used." "26.1") @@ -169,14 +152,12 @@ floats, otherwise the Emacs reader will fail on them." `calculator-displayer', to format a string before copying it with `calculator-copy'. If nil, then `calculator-displayer's normal value is used." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-2s-complement nil "If non-nil, show negative numbers in 2s complement in radix modes. Otherwise show as a negative number." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-mode-hook nil "List of hook functions for `calculator-mode' to run. @@ -184,8 +165,7 @@ Note: if `calculator-electric-mode' is on, then this hook will get activated in the minibuffer -- in that case it should not do much more than local key settings and other effects that will change things outside the scope of calculator related code." - :type 'hook - :group 'calculator) + :type 'hook) (defcustom calculator-user-registers nil "An association list of user-defined register bindings. @@ -200,8 +180,7 @@ before you load calculator." (when (boundp 'calculator-registers) (setq calculator-registers (append val calculator-registers))) - (setq calculator-user-registers val)) - :group 'calculator) + (setq calculator-user-registers val))) (defcustom calculator-user-operators nil "A list of additional operators. @@ -234,8 +213,7 @@ Examples: Note that this will be either postfix or prefix, according to `calculator-unary-style'." - :type '(repeat (list string symbol sexp integer integer)) - :group 'calculator) + :type '(repeat (list string symbol sexp integer integer))) ;;;===================================================================== ;;; Code: From a9b49dc31159283c962da61a259254b512e63ace Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Feb 2021 10:03:20 +0100 Subject: [PATCH 285/297] ; Fix indentation in test/README --- test/README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/README b/test/README index 877f77ab947..1e0e43a8aca 100644 --- a/test/README +++ b/test/README @@ -106,7 +106,7 @@ tramp-tests.el). Per default, a mock-up connection method is used to test a real remote connection, set $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to overwrite the default value: - env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ... + env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ... Some optional tests require packages from GNU ELPA. By default ../../elpa will be checked for these packages. If GNU ELPA is checked From dcb2015a5b644dafd61580c791f1f6625f5858e4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 10:21:14 +0100 Subject: [PATCH 286/297] Mention the GNU Kind Communications Guidelines in the FAQ * doc/misc/efaq.texi (Guidelines for newsgroup postings): Mention the GNU Kind Communications Guidelines. --- doc/misc/efaq.texi | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index fdfde96a991..c0536e0e3a2 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -388,6 +388,11 @@ posting a followup that recommends such software. @uref{news:gnu.emacs.bug} is a place where bug reports appear, but avoid posting bug reports to this newsgroup directly (@pxref{Reporting bugs}). +Finally, we recommend reading the +@url{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind +Communications Guidelines} before posting to any GNU lists or +newsgroups. + @node Newsgroup archives @section Where can I get old postings to @uref{news:gnu.emacs.help} and other GNU groups? @cindex Archived postings from @code{gnu.emacs.help} From d4f6927d48043d01929a93da53a64b1e4296f994 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 19 Feb 2021 13:44:25 +0100 Subject: [PATCH 287/297] Fix regexp mistakes * lisp/progmodes/cperl-mode.el (cperl--package-regexp): Avoid double repetition; cperl--ws-or-comment-regexp is already repeated with 1+. * test/lisp/textmodes/dns-mode-tests.el (dns-mode-tests-dns-mode-soa-increment-serial): Escape literal '$'. * test/lisp/emacs-lisp/rx-tests.el (rx-regexp): Modify test to not trigger a linting warning while retaining its testing power. --- lisp/progmodes/cperl-mode.el | 2 +- test/lisp/emacs-lisp/rx-tests.el | 4 ++-- test/lisp/textmodes/dns-mode-tests.el | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index d01bd3a48ef..db142c0dc3e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1305,7 +1305,7 @@ is a legal variable name).") (group (regexp ,cperl--normal-identifier-regexp)) (opt (sequence - (1+ (regexp ,cperl--ws-or-comment-regexp)) + (regexp ,cperl--ws-or-comment-regexp) (group (regexp ,cperl--version-regexp)))))) "A regular expression for package NAME VERSION in Perl. Contains two groups for the package name and version.") diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 388c5e86b4c..12bf4f7978e 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -388,11 +388,11 @@ (ert-deftest rx-regexp () (should (equal (rx (regexp "abc") (regex "[de]")) "\\(?:abc\\)[de]")) + (should (equal (rx "a" (regexp "$")) + "a\\(?:$\\)")) (let ((x "a*")) (should (equal (rx (regexp x) "b") "\\(?:a*\\)b")) - (should (equal (rx "a" (regexp "*")) - "a\\(?:*\\)")) (should (equal (rx "" (regexp x) (eval "")) "a*")))) diff --git a/test/lisp/textmodes/dns-mode-tests.el b/test/lisp/textmodes/dns-mode-tests.el index 92b6cc9177c..8bc48732c62 100644 --- a/test/lisp/textmodes/dns-mode-tests.el +++ b/test/lisp/textmodes/dns-mode-tests.el @@ -37,7 +37,7 @@ (dns-mode-soa-increment-serial) ;; Number is updated from 2015080302 to the current date ;; (actually, just ensure the year part is later than 2020). - (should (string-match "$TTL 86400 + (should (string-match "\\$TTL 86400 @ IN SOA ns.icann.org. noc.dns.icann.org. ( 20[2-9][0-9]+ ;Serial 7200 ;Refresh From 8e8b46ef818a5f94a9697dce1c49c6869d61deed Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 19 Feb 2021 15:16:31 +0200 Subject: [PATCH 288/297] More accurate documentation of the "r" interactive spec * doc/lispref/commands.texi (Interactive Codes): Describe the effect of 'mark-even-if-inactive'. --- doc/lispref/commands.texi | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 5385c03790d..7569ca6e691 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -488,7 +488,10 @@ I/O. Point and the mark, as two numeric arguments, smallest first. This is the only code letter that specifies two successive arguments rather than one. This will signal an error if the mark is not set in the buffer -which is current when the command is invoked. No I/O. +which is current when the command is invoked. If Transient Mark mode +is turned on (@pxref{The Mark}) --- as it is by default --- and user +option @code{mark-even-if-inactive} is @code{nil}, Emacs will signal +an error even if the mark @emph{is} set, but is inactive. No I/O. @item s Arbitrary text, read in the minibuffer and returned as a string From 6830199984b9964286fda8e4c904ce84aa68e514 Mon Sep 17 00:00:00 2001 From: Ulf Jasper Date: Fri, 19 Feb 2021 17:07:36 +0100 Subject: [PATCH 289/297] Enable newsticker--group-shift-feed-(up|down) to move groups as well Fix broken newsticker--group-shift-group-(up-down). * lisp/net/newst-treeview.el (newsticker-treeview-jump): Change prompt string. (newsticker--group-shift): Move the group when a group is currently selected. Fix error when explicitly shifting a group. (Fixes first issue in Bug#41376.) --- lisp/net/newst-treeview.el | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index cf55f66e780..a2d4d89ee55 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -1626,7 +1626,7 @@ Return t if a new feed was activated, nil otherwise." (interactive (list (let ((completion-ignore-case t)) (completing-read - "Jump to feed: " + "Jump to feed/group: " (append '("new" "obsolete" "immortal" "all") (mapcar #'car (append newsticker-url-list newsticker-url-list-defaults))) @@ -1852,28 +1852,34 @@ of the shift. If MOVE-GROUP is nil the currently selected feed `newsticker--treeview-current-feed' is shifted, if it is t then the current feed's parent group is shifted.." (let* ((cur-feed newsticker--treeview-current-feed) - (thing (if move-group - (newsticker--group-find-parent-group cur-feed) + (thing (if (and move-group + (not (newsticker--group-get-group cur-feed))) + (car (newsticker--group-find-parent-group cur-feed)) cur-feed)) (parent-group (newsticker--group-find-parent-group - (if move-group (car thing) thing)))) + ;;(if move-group (car thing) thing) + thing))) (unless parent-group (error "Group not found!")) (let* ((siblings (cdr parent-group)) - (pos (cl-position thing siblings :test 'equal)) + (pos (cl-position thing siblings :test + (lambda (o1 o2) + (equal (if (listp o1) (car o1) o1) + (if (listp o2) (car o2) o2))))) (tpos (+ pos delta )) (new-pos (max 0 (min (length siblings) tpos))) (beg (cl-subseq siblings 0 (min pos new-pos))) (end (cl-subseq siblings (+ 1 (max pos new-pos)))) (p (elt siblings new-pos))) (when (not (= pos new-pos)) - (setcdr parent-group - (cl-concatenate 'list - beg - (if (> delta 0) - (list p thing) - (list thing p)) - end)) + (let ((th (or (newsticker--group-get-group thing) thing))) + (setcdr parent-group + (cl-concatenate 'list + beg + (if (> delta 0) + (list p th) + (list th p)) + end))) (newsticker--treeview-tree-update) (newsticker-treeview-update) (newsticker-treeview-jump cur-feed))))) From 9b7eed33f94a65c4a9d1353aa052114415fc6381 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 Feb 2021 12:08:00 -0500 Subject: [PATCH 290/297] * test/lisp/emacs-lisp/edebug-tests.el: Adjust to new `edebug-eval-defun`. (edebug-tests-trivial-backquote): Adjust to the way `eval-defun` outputs its result. (edebug-tests-cl-macrolet): Adjust to the fact that now macro expansion takes place during the `eval-defun` even when Edebugging. --- test/lisp/emacs-lisp/edebug-tests.el | 34 ++++++++++++++---------- test/src/keyboard-tests.el | 39 ++++++++++++++++++++++------ 2 files changed, 51 insertions(+), 22 deletions(-) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index daac43372ac..dcb261c2eb9 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -219,16 +219,16 @@ index." (with-current-buffer (find-file-noselect edebug-tests-temp-file) (setq saved-local-map overriding-local-map) (setq overriding-local-map edebug-tests-keymap) - (add-hook 'post-command-hook 'edebug-tests-post-command)) + (add-hook 'post-command-hook #'edebug-tests-post-command)) (advice-add 'exit-recursive-edit - :around 'edebug-tests-preserve-keyboard-macro-state) + :around #'edebug-tests-preserve-keyboard-macro-state) (unwind-protect (kmacro-call-macro nil nil nil kbdmac) (advice-remove 'exit-recursive-edit - 'edebug-tests-preserve-keyboard-macro-state) + #'edebug-tests-preserve-keyboard-macro-state) (with-current-buffer (find-file-noselect edebug-tests-temp-file) (setq overriding-local-map saved-local-map) - (remove-hook 'post-command-hook 'edebug-tests-post-command))))) + (remove-hook 'post-command-hook #'edebug-tests-post-command))))) (defun edebug-tests-preserve-keyboard-macro-state (orig &rest args) "Call ORIG with ARGS preserving the value of `executing-kbd-macro'. @@ -857,12 +857,14 @@ test and possibly others should be updated." (ert-deftest edebug-tests-trivial-backquote () "Edebug can instrument a trivial backquote expression (Bug#23651)." (edebug-tests-with-normal-env - (read-only-mode -1) - (delete-region (point-min) (point-max)) - (insert "`1") - (read-only-mode) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert "`1")) (edebug-eval-defun nil) - (should (string-match-p (regexp-quote "1 (#o1, #x1, ?\\C-a)") + ;; `eval-defun' outputs its message to the echo area in a rather + ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed + ;; there in separate pieces (via `print' rather than via `message'). + (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)") edebug-tests-messages)) (setq edebug-tests-messages "") @@ -912,13 +914,17 @@ test and possibly others should be updated." (ert-deftest edebug-tests-cl-macrolet () "Edebug can instrument `cl-macrolet' expressions. (Bug#29919)" (edebug-tests-with-normal-env - (edebug-tests-setup-@ "use-cl-macrolet" '(10) t) + (edebug-tests-locate-def "use-cl-macrolet") (edebug-tests-run-kbd-macro - "@ SPC SPC" + "C-u C-M-x SPC" (edebug-tests-should-be-at "use-cl-macrolet" "func") - (edebug-tests-should-match-result-in-messages "+") - "g" - (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11"))))) + (edebug-tests-should-match-result-in-messages "+")) + (let ((edebug-initial-mode 'Go-nonstop)) + (edebug-tests-setup-@ "use-cl-macrolet" '(10) t)) + (edebug-tests-run-kbd-macro + "@ SPC g" + (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11")) + ))) (ert-deftest edebug-tests-backtrace-goto-source () "Edebug can jump to instrumented source from its *Edebug-Backtrace* buffer." diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el index 607d2eafd45..41c8cdd15f0 100644 --- a/test/src/keyboard-tests.el +++ b/test/src/keyboard-tests.el @@ -23,14 +23,15 @@ (ert-deftest keyboard-unread-command-events () "Test `unread-command-events'." - (should (equal (progn (push ?\C-a unread-command-events) - (read-event nil nil 1)) - ?\C-a)) - (should (equal (progn (run-with-timer - 1 nil - (lambda () (push '(t . ?\C-b) unread-command-events))) - (read-event nil nil 2)) - ?\C-b))) + (let ((unread-command-events nil)) + (should (equal (progn (push ?\C-a unread-command-events) + (read-event nil nil 1)) + ?\C-a)) + (should (equal (progn (run-with-timer + 1 nil + (lambda () (push '(t . ?\C-b) unread-command-events))) + (read-event nil nil 2)) + ?\C-b)))) (ert-deftest keyboard-lossage-size () "Test `lossage-size'." @@ -46,6 +47,28 @@ (should-error (lossage-size (1- min-value))) (should (= lossage-orig (lossage-size lossage-orig))))) +;; FIXME: This test doesn't currently work :-( +;; (ert-deftest keyboard-tests--echo-keystrokes-bug15332 () +;; (let ((msgs '()) +;; (unread-command-events nil) +;; (redisplay--interactive t) +;; (echo-keystrokes 2)) +;; (setq unread-command-events '(?\C-u)) +;; (let* ((timer1 +;; (run-with-timer 3 1 +;; (lambda () +;; (setq unread-command-events '(?5))))) +;; (timer2 +;; (run-with-timer 2.5 1 +;; (lambda () +;; (push (current-message) msgs))))) +;; (run-with-timer 5 nil +;; (lambda () +;; (cancel-timer timer1) +;; (cancel-timer timer2) +;; (throw 'exit msgs))) +;; (recursive-edit) +;; (should (equal msgs '("C-u 55-" "C-u 5-" "C-u-")))))) (provide 'keyboard-tests) ;;; keyboard-tests.el ends here From b6eccad06c89eea878c1464571255fe8ce5c6d86 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 Feb 2021 12:51:36 -0500 Subject: [PATCH 291/297] * lisp/emacs-lisp/bytecomp.el: Don't warn for repeated _ args (byte-compile-check-lambda-list): Skip warnings of repeated arg for those that are declared as unused anyway. --- lisp/emacs-lisp/bytecomp.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 9d80afd774f..1b0906b50bb 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2859,7 +2859,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." ((eq arg '&optional) (when (memq '&optional (cdr list)) (error "Duplicate &optional"))) - ((memq arg vars) + ((and (memq arg vars) + ;; Allow repetitions for unused args. + (not (string-match "\\`_" (symbol-name arg)))) (byte-compile-warn "repeated variable %s in lambda-list" arg)) (t (push arg vars)))) From 283f98353fe3549ac8f66a3ab8fba85d93c81a88 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Fri, 19 Feb 2021 19:25:39 +0000 Subject: [PATCH 292/297] Fix frame contents scaling bug on macOS (bug#46155) Discussion in bug#46406. * src/nsterm.m ([EmacsView focusOnDrawingBuffer:]): Set the scale factor for the backing layer. --- src/nsterm.m | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/nsterm.m b/src/nsterm.m index b0cf5952fd5..6551694abee 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -8377,6 +8377,11 @@ - (void)focusOnDrawingBuffer surface = [[EmacsSurface alloc] initWithSize:s ColorSpace:[[[self window] colorSpace] CGColorSpace]]; + + /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay + the layer's scale factor is not set automatically, so do it + now. */ + [[self layer] setContentsScale:[[self window] backingScaleFactor]]; } CGContextRef context = [surface getContext]; From ade9c22c0497f50e492a8fe8c0356c0c28e313b3 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Fri, 19 Feb 2021 17:07:52 -0500 Subject: [PATCH 293/297] ntlm-tests: Skip tests if dependencies are too old * test/lisp/net/ntlm-tests.el (ntlm-tests--dependencies-present): Add version and functionality checks. Co-authored-by: Michael Albinus --- test/lisp/net/ntlm-tests.el | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el index 0ed430afe68..c31ab83226c 100644 --- a/test/lisp/net/ntlm-tests.el +++ b/test/lisp/net/ntlm-tests.el @@ -382,8 +382,25 @@ ARGUMENTS are passed to it." (concat "HTTP/1.1 200 OK\n\nAuthenticated." (unibyte-string 13) "\n") "Expected result of successful NTLM authentication.") +(require 'find-func) +(defun ntlm-tests--ensure-ws-parse-ntlm-support () + "Ensure NTLM special-case in `ws-parse'." + (let* ((hit (find-function-search-for-symbol + 'ws-parse nil (locate-file "web-server.el" load-path))) + (buffer (car hit)) + (position (cdr hit))) + (with-current-buffer buffer + (goto-char position) + (search-forward-regexp + ":NTLM" (save-excursion (forward-sexp) (point)) t)))) + +(require 'lisp-mnt) (defvar ntlm-tests--dependencies-present - (and (featurep 'url-http-ntlm) (featurep 'web-server)) + (and (featurep 'url-http-ntlm) + (version<= "2.0.4" + (lm-version (locate-file "url-http-ntlm.el" load-path))) + (featurep 'web-server) + (ntlm-tests--ensure-ws-parse-ntlm-support)) "Non-nil if GNU ELPA test dependencies were loaded.") (when (not ntlm-tests--dependencies-present) From 7366859fe0e185155cbe426903c6081ec1723be1 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Fri, 19 Feb 2021 17:11:16 -0500 Subject: [PATCH 294/297] ntlm-tests: Remove missing dependency warnings * test/lisp/net/ntlm-tests.el: Remove warnings about dependencies not being present. --- test/lisp/net/ntlm-tests.el | 9 --------- 1 file changed, 9 deletions(-) diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el index c31ab83226c..2420b3b48a9 100644 --- a/test/lisp/net/ntlm-tests.el +++ b/test/lisp/net/ntlm-tests.el @@ -403,15 +403,6 @@ ARGUMENTS are passed to it." (ntlm-tests--ensure-ws-parse-ntlm-support)) "Non-nil if GNU ELPA test dependencies were loaded.") -(when (not ntlm-tests--dependencies-present) - (warn "Cannot find one or more GNU ELPA packages") - (when (not (featurep 'url-http-ntlm)) - (warn "Need url-http-ntlm/url-http-ntlm.el")) - (when (not (featurep 'web-server)) - (warn "Need web-server/web-server.el")) - (warn "Skipping NTLM authentication tests") - (warn "See GNU_ELPA_DIRECTORY in test/README")) - (ert-deftest ntlm-authentication () "Check ntlm.el's implementation of NTLM authentication over HTTP." (skip-unless ntlm-tests--dependencies-present) From 5f539581a461ebdfec107bc2648a399bac888c49 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Fri, 19 Feb 2021 17:32:59 -0500 Subject: [PATCH 295/297] * lisp/url/url-http.el (url-http): Fix docstring typo. --- lisp/url/url-http.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 8cebd4e79f6..e3c178630ae 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1292,7 +1292,7 @@ passing it an updated value of CBARGS as arguments. The first element in CBARGS should be a plist describing what has happened so far during the request, as described in the docstring of `url-retrieve' (if in doubt, specify nil). The current buffer -then CALLBACK is executed is the retrieval buffer. +when CALLBACK is executed is the retrieval buffer. Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a previous `url-http' call, which is being re-attempted. From b612f1a41f3f0282da6bbe1f7864d93ec9ac8007 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Feb 2021 04:21:35 +0100 Subject: [PATCH 296/297] * lisp/woman.el: Doc fix; remove redundant setup info. --- lisp/woman.el | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/lisp/woman.el b/lisp/woman.el index 9a03d30bb7f..98f1a47d24c 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -69,13 +69,7 @@ ;; Recommended use ;; =============== -;; Put this in your .emacs: -;; (autoload 'woman "woman" -;; "Decode and browse a UN*X man page." t) -;; (autoload 'woman-find-file "woman" -;; "Find, decode and browse a specific UN*X man-page file." t) - -;; Then either (1 -- *RECOMMENDED*): If the `MANPATH' environment +;; Either (1 -- *RECOMMENDED*): If the `MANPATH' environment ;; variable is set then WoMan will use it; otherwise you may need to ;; reset the Lisp variable `woman-manpath', and you may also want to ;; set the Lisp variable `woman-path'. Please see the online @@ -139,14 +133,8 @@ ;; ============================== ;; WoMan supports the GNU Emacs customization facility, and puts -;; a customization group called `WoMan' in the `Help' group under the -;; top-level `Emacs' group. In order to be able to customize WoMan -;; without first loading it, add the following sexp to your .emacs: - -;; (defgroup woman nil -;; "Browse UNIX manual pages `wo (without) man'." -;; :tag "WoMan" :group 'help :load "woman") - +;; a customization group called `woman' in the `help' group under the +;; top-level `emacs' group. ;; WoMan currently runs two hooks: `woman-pre-format-hook' immediately ;; before formatting a buffer and `woman-post-format-hook' immediately From c85c8e7d42ae2a5fc95fa7b14257389d8383b34d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Feb 2021 05:55:33 +0100 Subject: [PATCH 297/297] Add toolbar for help-mode * lisp/help-mode.el (help-mode): Add toolbar. (help-mode-tool-bar-map): New variable. (help-mode-menu): Disable forward/backward items when stack is empty. (help-bookmark-make-record, help-bookmark-jump): Minor doc fixes. --- lisp/help-mode.el | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 79710a18073..30a1ce053c1 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -54,14 +54,30 @@ ["Show Help for Symbol" help-follow-symbol :help "Show the docs for the symbol at point"] ["Previous Topic" help-go-back - :help "Go back to previous topic in this help buffer"] + :help "Go back to previous topic in this help buffer" + :active help-xref-stack] ["Next Topic" help-go-forward - :help "Go back to next topic in this help buffer"] + :help "Go back to next topic in this help buffer" + :active help-xref-forward-stack] ["Move to Previous Button" backward-button :help "Move to the Previous Button in the help buffer"] ["Move to Next Button" forward-button :help "Move to the Next Button in the help buffer"])) +(defvar help-mode-tool-bar-map + (let ((map (make-sparse-keymap))) + (tool-bar-local-item "close" 'quit-window 'quit map + :label "Quit help." + :vert-only t) + (define-key-after map [separator-1] menu-bar-separator) + (tool-bar-local-item "search" 'isearch-forward 'search map + :label "Search" :vert-only t) + (tool-bar-local-item-from-menu 'help-go-back "left-arrow" map help-mode-map + :rtl "right-arrow" :vert-only t) + (tool-bar-local-item-from-menu 'help-go-forward "right-arrow" map help-mode-map + :rtl "left-arrow" :vert-only t) + map)) + (defvar-local help-xref-stack nil "A stack of ways by which to return to help buffers after following xrefs. Used by `help-follow' and `help-xref-go-back'. @@ -317,6 +333,8 @@ Commands: \\{help-mode-map}" (setq-local revert-buffer-function #'help-mode-revert-buffer) + (setq-local tool-bar-map + help-mode-tool-bar-map) (setq-local bookmark-make-record-function #'help-bookmark-make-record)) @@ -778,8 +796,8 @@ help buffer by other means." (&optional no-file no-context posn)) (defun help-bookmark-make-record () - "Create and return a help-mode bookmark record. -Implements `bookmark-make-record-function' for help-mode buffers." + "Create and return a `help-mode' bookmark record. +Implements `bookmark-make-record-function' for `help-mode' buffers." (unless (car help-xref-stack-item) (error "Cannot create bookmark - help command not known")) `(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT) @@ -792,7 +810,7 @@ Implements `bookmark-make-record-function' for help-mode buffers." ;;;###autoload (defun help-bookmark-jump (bookmark) - "Jump to help-mode bookmark BOOKMARK. + "Jump to `help-mode' bookmark BOOKMARK. Handler function for record returned by `help-bookmark-make-record'. BOOKMARK is a bookmark name or a bookmark record." (let ((help-fn (bookmark-prop-get bookmark 'help-fn))