diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2021-02-08 12:16:02 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-02-08 12:16:02 -0700 |
| commit | 1f01a9ab16350374d7df67c767d2fd85d42d0ac7 (patch) | |
| tree | 9b01ed5bc17a39caf5ad68dba699cb2bc006869b | |
| parent | 964c3c258f9c297e9dbb27c85f6f55021d866ba6 (diff) | |
| parent | 4428c27c1ae7d5fe5233e8d7b001a8cd2fcdc56f (diff) | |
| download | emacs-1f01a9ab16350374d7df67c767d2fd85d42d0ac7.tar.gz | |
Merge remote-tracking branch 'origin/master' into athena/unstable
64 files changed, 933 insertions, 501 deletions
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. 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..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. @@ -1755,13 +1759,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/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/doc/emacs/indent.texi b/doc/emacs/indent.texi index df9e67fee68..d989f345566 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). 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/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/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/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. - -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): +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 +(@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 diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 4a316a1bddb..2df6c15c4ca 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 @@ -87,6 +87,10 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". ** 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. + ** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. @@ -234,7 +238,12 @@ 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. +** 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 n' +('clone-buffer'), 'C-x x i' ('insert-buffer') and 'C-x x t' +('toggle-truncate-lines'). * Editing Changes in Emacs 28.1 @@ -465,9 +474,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 +++ @@ -588,6 +602,12 @@ 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 'vc-handled-backends' to determine which backend is responsible for a 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 diff --git a/lisp/bindings.el b/lisp/bindings.el index 9ea188d1a00..2f4bab11cf5 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1413,7 +1413,17 @@ 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) + (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) + "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) 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/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 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 27fdb723441..c0a4a6dda06 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -343,7 +343,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/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 66a117fccc8..abbe2a2e63f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -368,6 +368,54 @@ ;;; 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 KEEP [VALUE]), where: + NAME is the variable name, + 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 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 + "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 +430,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 for retention 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 +457,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 <x>) --> <x>. (if (cdr exps) @@ -442,35 +492,56 @@ (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 (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) + (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 +556,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))) - - (`(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, + (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 ,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 +594,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 to be kept, 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 +614,36 @@ ;; 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) + ;; 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. + (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 +701,65 @@ 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 [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))) + (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 +768,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/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) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index cf129c453ec..ec746fa4747 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -135,7 +135,6 @@ PATTERN matches. PATTERN can take one of the forms: (pred (not FUN)) matches if FUN called on EXPVAL returns nil. (app FUN PAT) matches if FUN called on EXPVAL matches PAT. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. - (let PAT EXPR) matches if EXPR matches PAT. (and PAT...) matches if all the patterns match. (or PAT...) matches if any of the patterns matches. @@ -145,7 +144,7 @@ FUN in `pred' and `app' can take one of the forms: (F ARG1 .. ARGn) call F with ARG1..ARGn and EXPVAL as n+1'th argument -FUN, BOOLEXP, EXPR, and subsequent PAT can refer to variables +FUN, BOOLEXP, and subsequent PAT can refer to variables bound earlier in the pattern by a SYMBOL pattern. Additional patterns can be defined using `pcase-defmacro'. @@ -426,7 +425,6 @@ of the elements of LIST is performed as if by `pcase-let'. (if (pcase--self-quoting-p pat) `',pat pat)) ((memq head '(pred guard quote)) pat) ((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat)))) - ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat))) ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) (t (let* ((expander (pcase--get-macroexpander head)) @@ -888,18 +886,9 @@ Otherwise, it defers to REST which is a list of branches of the form (if (not (assq upat vars)) (pcase--u1 matches code (cons (cons upat sym) vars) rest) ;; Non-linear pattern. Turn it into an `eq' test. - (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars))))) + (pcase--u1 (cons `(match ,sym . (pred (eql ,(cdr (assq upat vars))))) matches) code vars rest))) - ((eq (car-safe upat) 'let) - ;; A upat of the form (let VAR EXP). - ;; (pcase--u1 matches code - ;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest) - (macroexp-let2 - macroexp-copyable-p sym - (pcase--eval (nth 2 upat) vars) - (pcase--u1 (cons (pcase--match sym (nth 1 upat)) matches) - code vars rest))) ((eq (car-safe upat) 'app) ;; A upat of the form (app FUN PAT) (pcase--mark-used sym) @@ -1011,5 +1000,9 @@ The predicate is the logical-AND of: ;; compounded values that are not `consp' (t (error "Unknown QPAT: %S" qpat)))) +(pcase-defmacro let (pat expr) + "Matches if EXPR matches PAT." + `(app (lambda (_) ,expr) ,pat)) + (provide 'pcase) ;;; pcase.el ends here diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 312e38769c5..75b27d08e56 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)) @@ -518,7 +518,7 @@ form to be treated accordingly." (setq val (testcover-analyze-coverage-wrapped-form wrapped-form)) (when (or (eq wrapper '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) ;; 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)) @@ -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)))) 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/face-remap.el b/lisp/face-remap.el index 7fbf0c42be7..5914ee4a202 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -354,9 +354,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 diff --git a/lisp/frame.el b/lisp/frame.el index 06aab269ddd..ce4de83b8c5 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1370,6 +1370,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) 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)))))) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index f3e08519c3e..21602f825c1 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))) @@ -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)))) 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) 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). diff --git a/lisp/indent.el b/lisp/indent.el index 4a5550786d5..5cbf0acaa25 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -250,7 +250,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-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]. -Typing any other key exits this mode. If `transient-mark-mode' is enabled, +Typing any other key exits this mode, and this key is then +acted upon as normally. If `transient-mark-mode' is enabled, exiting also deactivates the mark. If called from a program, or interactively with prefix ARG, diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index d88c0b48f93..8ad4fe4e637 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -1,34 +1,36 @@ ;;; dictionary-connection.el --- TCP-based client connection for dictionary -*- lexical-binding:t -*- +;; Copyright (C) 2021 Free Software Foundation, Inc. + ;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net> ;; Keywords: network -;; This file 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, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; This file 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 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 <https://www.gnu.org/licenses/>. ;;; 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) @@ -147,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) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index f8733429e94..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 <torsten.hilbrich@gmx.net> ;; Keywords: interface, dictionary -;; This file 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, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; This file 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 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 <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -46,7 +48,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 +75,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 +87,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 +103,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 +145,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 +177,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 +185,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 +200,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 +283,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 +330,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 +344,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 +356,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-mode-map> +* \\[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 <mouse-2> visit that link" (unless (eq major-mode 'dictionary-mode) (cl-incf dictionary-instances)) @@ -399,7 +399,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 +498,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 +535,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 +566,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 +589,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 +623,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 +631,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 +645,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 +664,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 +680,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 +711,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 +775,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 +809,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 +929,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 +1009,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 +1232,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 +1294,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 +1306,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 +1330,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) 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) 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/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) 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/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) 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/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 e4a363a9a59..568debaa612 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)))) ;;; @@ -1443,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) @@ -1458,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)) @@ -1472,27 +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)))))))) - -(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." - (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))))))) + (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'." diff --git a/lisp/subr.el b/lisp/subr.el index 6e52bd20df2..f0de6d5ac92 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2228,9 +2228,13 @@ 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. + (when-let ((alias (symbol-function mode))) + (when (symbolp alias) + (setq mode alias))) (while (and (not (memq mode modes)) 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) 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) 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") 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. 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. diff --git a/src/editfns.c b/src/editfns.c index e3285494c14..991f79abac7 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3134,6 +3134,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) char *format_start = SSDATA (args[0]); bool multibyte_format = STRING_MULTIBYTE (args[0]); ptrdiff_t formatlen = SBYTES (args[0]); + bool fmt_props = string_intervals (args[0]); /* Upper bound on number of format specs. Each uses at least 2 chars. */ ptrdiff_t nspec_bound = SCHARS (args[0]) >> 1; @@ -3406,13 +3407,20 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) convbytes += padding; if (convbytes <= buf + bufsize - p) { + /* If the format spec has properties, we should account + for the padding on the left in the info[] array. */ + if (fmt_props) + spec->start = nchars; if (! minus_flag) { memset (p, ' ', padding); p += padding; nchars += padding; } - spec->start = nchars; + /* If the properties will come from the argument, we + don't extend them to the left due to padding. */ + if (!fmt_props) + spec->start = nchars; if (p > buf && multibyte diff --git a/src/fns.c b/src/fns.c index bd4afa0c4e9..02743c62a57 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5758,6 +5758,38 @@ in OBJECT. */) traverse_intervals (intervals, 0, collect_interval, collector); return CDR (collector); } + +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. 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; + + if (MARKERP (position)) + pos = marker_position (position); + else 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 (start), make_int (ZV)); + + return make_int (count_lines (start, CHAR_TO_BYTE (pos)) + 1); +} void @@ -5800,6 +5832,7 @@ syms_of_fns (void) defsubr (&Sdefine_hash_table_test); defsubr (&Sstring_search); defsubr (&Sobject_intervals); + defsubr (&Sline_number_at_pos); /* Crypto and hashing stuff. */ DEFSYM (Qiv_auto, "iv-auto"); 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 @@ ns_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) 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 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 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/xdisp.c b/src/xdisp.c index 764735769b4..1815f986781 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10780,8 +10780,8 @@ include the height of both, if present, in the return value. */) if (it.current_y > start_y) start_x = 0; - /* Subtract height of header-line which was counted automatically by - start_display. */ + /* Subtract height of header-line and tab-line which was counted + automatically by start_display. */ y = it.current_y + it.max_ascent + it.max_descent - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w); /* Don't return more than Y-LIMIT. */ 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,36 +3927,31 @@ This function is an internal primitive--use `make-frame' instead. */) parms); } + gui_default_parameter (f, parms, Qinternal_border_width, +#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */ + make_fixnum (0), +#else + make_fixnum (1), +#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, - "childFrameBorderWidth", "childFrameBorderWidth", + "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, -#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, parms, Qchild_frame_border_width, Qnil, "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), -#else - make_fixnum (1), -#endif - "internalBorderWidth", "internalBorderWidth", - 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), 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.") 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")) 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 @@ -48,6 +48,26 @@ (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) (declare (indent 0) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 64f9137865b..dcec971c12e 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -106,7 +106,27 @@ #("foobar" 3 6 (face error)))) (should (ert-equal-including-properties (format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar") - #("foo bar" 4 7 (face error))))) + #("foo bar" 4 7 (face error)))) + ;; Bug #46317 + (let ((s (propertize "X" 'prop "val"))) + (should (ert-equal-including-properties + (format (concat "%3s/" s) 12) + #(" 12/X" 4 5 (prop "val")))) + (should (ert-equal-including-properties + (format (concat "%3S/" s) 12) + #(" 12/X" 4 5 (prop "val")))) + (should (ert-equal-including-properties + (format (concat "%3d/" s) 12) + #(" 12/X" 4 5 (prop "val")))) + (should (ert-equal-including-properties + (format (concat "%-3s/" s) 12) + #("12 /X" 4 5 (prop "val")))) + (should (ert-equal-including-properties + (format (concat "%-3S/" s) 12) + #("12 /X" 4 5 (prop "val")))) + (should (ert-equal-including-properties + (format (concat "%-3d/" s) 12) + #("12 /X" 4 5 (prop "val")))))) ;; Tests for bug#5131. (defun transpose-test-reverse-word (start end) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index e0aed2a71b6..928fb15f109 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-pos (point)) 11)) + (should (= (line-number-at-pos nil) 11)) + (should-error (line-number-at-pos -1)) + (should-error (line-number-at-pos 100)))) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index a3fba8d328b..e62bcb3f7c0 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -879,5 +879,33 @@ 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 Windows sends \"interrupt\" to 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 (_prc 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 |