From 89f1634afcca318def07151424a21b81c70acd76 Mon Sep 17 00:00:00 2001 From: Alexandre Duret-Lutz Date: Mon, 11 Jan 2021 15:27:54 +0100 Subject: Fix problem with non-ASCII characters in nnmaildir * lisp/gnus/nnmaildir.el (nnmaildir-request-article): Enable multipart 8bit-content-transfer-encoded files to be displayed correctly by reading as `raw-text' instead of having Emacs (incorrectly) decode the files (bug#44307). Copyright-paperwork-exempt: yes --- lisp/gnus/nnmaildir.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 9cf766ee465..5461c4c960e 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1351,7 +1351,8 @@ This variable is set by `nnmaildir-request-article'.") (throw 'return nil)) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) - (nnheader-insert-file-contents nnmaildir-article-file-name)) + (let ((coding-system-for-read mm-text-coding-system)) + (mm-insert-file-contents nnmaildir-article-file-name))) (cons gname num-msgid)))) (defun nnmaildir-request-post (&optional _server) -- cgit v1.2.3 From 256356a36fa15c17968febfb3fa49ac33872a11e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Feb 2021 12:02:53 +0100 Subject: Clarify the "Sentinels" node in the lispref manual * doc/lispref/processes.texi (Sentinels): Mention "run" and that the strings can be anything (bug#30461). (cherry picked from commit 859a4cb6b22f75a3456e29d08fcfe9b8940fbe8b) --- doc/lispref/processes.texi | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 42f436501fd..063b5f51340 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1969,7 +1969,8 @@ describing the type of event. default sentinel function, which inserts a message in the process's buffer with the process name and the string describing the event. - The string describing the event looks like one of the following: + The string describing the event looks like one of the following (but +this is not an exhaustive list of event strings): @itemize @bullet @item @@ -1999,6 +2000,9 @@ core. @item @code{"open\n"}. +@item +@code{"run\n"}. + @item @code{"connection broken by remote peer\n"}. @end itemize -- cgit v1.2.3 From d1455027e0b04b67e903f5ef658a3fd65ca4da48 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Feb 2021 20:21:18 +0200 Subject: Initialize signal descriptions after pdumping * src/sysdep.c (init_signals) [!HAVE_DECL_SYS_SIGLIST]: Reinit sys_siglist also after pdumping. (Bug#46284) --- src/sysdep.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/sysdep.c b/src/sysdep.c index f94ce4d4920..d100a5cb50b 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1980,7 +1980,8 @@ init_signals (void) #endif #if !HAVE_DECL_SYS_SIGLIST && !defined _sys_siglist - if (! initialized) + if (! initialized + || dumped_with_pdumper_p ()) { sys_siglist[SIGABRT] = "Aborted"; # ifdef SIGAIO -- cgit v1.2.3 From 19534f988c0f29199dfd51d627392bccf7426253 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 9 Jan 2021 02:08:59 +0200 Subject: Make sure default-directory relates to the originating buffer * lisp/progmodes/xref.el (xref--show-xref-buffer): Pick up default-directory value from the caller (https://lists.gnu.org/archive/html/emacs-devel/2021-01/msg00551.html). (xref-show-definitions-buffer-at-bottom): Same. (cherry picked from commit 6e73e07a6f5cbdd1c5ae6e0f3fbd0f8f56813f1a) --- lisp/progmodes/xref.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 4c53c09d7b3..309f48a8177 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -852,8 +852,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (or (assoc-default 'fetched-xrefs alist) (funcall fetcher))) - (xref-alist (xref--analyze xrefs))) + (xref-alist (xref--analyze xrefs)) + (dd default-directory)) (with-current-buffer (get-buffer-create xref-buffer-name) + (setq default-directory dd) (xref--xref-buffer-mode) (xref--show-common-initialize xref-alist fetcher alist) (pop-to-buffer (current-buffer)) @@ -903,13 +905,15 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." When there is more than one definition, split the selected window and show the list in a small window at the bottom. And use a local keymap that binds `RET' to `xref-quit-and-goto-xref'." - (let ((xrefs (funcall fetcher))) + (let ((xrefs (funcall fetcher)) + (dd default-directory)) (cond ((not (cdr xrefs)) (xref-pop-to-location (car xrefs) (assoc-default 'display-action alist))) (t (with-current-buffer (get-buffer-create xref-buffer-name) + (setq default-directory dd) (xref--transient-buffer-mode) (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) (pop-to-buffer (current-buffer) -- cgit v1.2.3 From b99848c72cb2570cfcab98443be9156b66dee830 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 4 Feb 2021 03:38:27 +0200 Subject: Bind default-directory to the project root * lisp/progmodes/project.el (project-find-regexp): Bind default-directory to the project root, to save this value in the resulting buffer (esp. if the project selector was used, (https://lists.gnu.org/archive/html/emacs-devel/2021-02/msg00140.html). (project-or-external-find-regexp): Same. (cherry picked from commit c07ebfcbe084e8219d8c2588f23f77ba4ef39087) --- lisp/progmodes/project.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 1caf8bed7d2..2b35ea412f7 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -441,6 +441,7 @@ requires quoting, e.g. `\\[quoted-insert]'." (require 'xref) (require 'grep) (let* ((pr (project-current t)) + (default-directory (project-root pr)) (files (if (not current-prefix-arg) (project-files pr (project-roots pr)) @@ -473,6 +474,7 @@ pattern to search for." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) + (default-directory (project-root pr)) (files (project-files pr (append (project-roots pr) -- cgit v1.2.3 From fc37dc298f27025823fad2d944e11cc7ee6a058d Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 5 Feb 2021 01:17:09 +0200 Subject: Fix the previous change * lisp/progmodes/project.el (project-find-regexp): Fix the previous change (project-root is not defined in this version). (project-or-external-find-regexp): Same. --- lisp/progmodes/project.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 2b35ea412f7..ca0755cf8cd 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -441,7 +441,7 @@ requires quoting, e.g. `\\[quoted-insert]'." (require 'xref) (require 'grep) (let* ((pr (project-current t)) - (default-directory (project-root pr)) + (default-directory (car (project-roots pr))) (files (if (not current-prefix-arg) (project-files pr (project-roots pr)) @@ -474,7 +474,7 @@ pattern to search for." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) - (default-directory (project-root pr)) + (default-directory (car (project-roots pr))) (files (project-files pr (append (project-roots pr) -- cgit v1.2.3 From 8c27af3ff465fe78c635a8acd1debc9c63bfa7f3 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 5 Feb 2021 11:00:07 +0100 Subject: Clarify how transient indentation modes are exited in the manual * doc/emacs/indent.texi (Indentation Commands): Clarify that the other keys don't just exit the transient mode, but are also handled as normally (bug#46296). --- doc/emacs/indent.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index ceb911bef90..cca9432fa4f 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -136,8 +136,8 @@ this transient mode is active, typing @kbd{@key{LEFT}} or @kbd{@key{RIGHT}} indents leftward and rightward, respectively, by one space. You can also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to indent leftward or rightward to the next tab stop (@pxref{Tab Stops}). -Typing any other key disables the transient mode, and resumes normal -editing. +Typing any other key disables the transient mode, and this key is then +acted upon as normally. If called with a prefix argument @var{n}, this command indents the lines forward by @var{n} spaces (without enabling the transient mode). -- cgit v1.2.3 From 43bf7f1b06f5ca21a3af166e803b632934e6674d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 5 Feb 2021 09:36:58 +0100 Subject: Correct the lispref manual about flushing ppss info * doc/lispref/syntax.texi (Syntax Properties): Correct the information about flushing the state by copying the text from the doc string (bug#46274). (cherry picked from commit ff701ce2b261acce1dfcd1fe137268d87d5eab35) --- doc/lispref/syntax.texi | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index b4bd48771f0..58f07c9644d 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -573,10 +573,10 @@ and by Font Lock mode during syntactic fontification (@pxref{Syntactic Font Lock}). It is called with two arguments, @var{start} and @var{end}, which are the starting and ending positions of the text on which it should act. It is allowed to call @code{syntax-ppss} on any -position before @var{end}. However, it should not call -@code{syntax-ppss-flush-cache}; so, it is not allowed to call -@code{syntax-ppss} on some position and later modify the buffer at an -earlier position. +position before @var{end}, but if it calls @code{syntax-ppss} on some +position and later modifies the buffer on some earlier position, +then it is its responsibility to call @code{syntax-ppss-flush-cache} +to flush the now obsolete info from the cache. @strong{Caution:} When this variable is non-@code{nil}, Emacs removes @code{syntax-table} text properties arbitrarily and relies on -- cgit v1.2.3 From c71e08eba94fc821616ab8d48847ff7130974d61 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 5 Feb 2021 13:06:07 +0200 Subject: Fix last change in syntax.texi * doc/lispref/syntax.texi (Syntax Properties): Fix wording in last change. (Bug#46274) --- doc/lispref/syntax.texi | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 58f07c9644d..9adffcc18d3 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -573,10 +573,11 @@ and by Font Lock mode during syntactic fontification (@pxref{Syntactic Font Lock}). It is called with two arguments, @var{start} and @var{end}, which are the starting and ending positions of the text on which it should act. It is allowed to call @code{syntax-ppss} on any -position before @var{end}, but if it calls @code{syntax-ppss} on some -position and later modifies the buffer on some earlier position, -then it is its responsibility to call @code{syntax-ppss-flush-cache} -to flush the now obsolete info from the cache. +position before @var{end}, but if a Lisp program calls +@code{syntax-ppss} on some position and later modifies the buffer at +some earlier position, then it is that program's responsibility to +call @code{syntax-ppss-flush-cache} to flush the now obsolete info +from the cache. @strong{Caution:} When this variable is non-@code{nil}, Emacs removes @code{syntax-table} text properties arbitrarily and relies on -- cgit v1.2.3 From a6f23c226e601d6682f057056fe4c7a069a9f69a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 5 Feb 2021 22:04:15 +0200 Subject: ; * src/xdisp.c (Fwindow_text_pixel_size): Fix comment. --- src/xdisp.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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. */ -- cgit v1.2.3 From 431b098a206d27a2dff6a88312c28c36926f90e9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 5 Feb 2021 15:07:47 -0500 Subject: * lisp/emacs-lisp/pcase.el (let): Reimplement as a pcase macro (pcase--macroexpand, pcase--u1): Remove handling of `let` from `pcase`s core. --- lisp/emacs-lisp/pcase.el | 19 ++++++------------- 1 file changed, 6 insertions(+), 13 deletions(-) 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 -- cgit v1.2.3 From 6c5ddf0e0bc4e3e3ed819835f00419b7289d33c7 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sat, 6 Feb 2021 09:28:40 +0100 Subject: Fix two small tab bar issues * lisp/cus-start.el (frame-inhibit-implied-resize): Update version tag. * lisp/frame.el (frame-inner-height): Do not count in tab bar. --- lisp/cus-start.el | 2 +- lisp/frame.el | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 4b7c3863063..b7f0d7e2a85 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -336,7 +336,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "Never" nil) (const :tag "Always" t) (repeat (symbol :tag "Parameter"))) - "25.1") + "27.1") (iconify-child-frame frames (choice (const :tag "Do nothing" nil) diff --git a/lisp/frame.el b/lisp/frame.el index 7f1b8af9190..15e46c9e210 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1344,6 +1344,7 @@ FRAME defaults to the selected frame." FRAME defaults to the selected frame." (setq frame (window-normalize-frame frame)) (- (frame-native-height frame) + (tab-bar-height frame t) (* 2 (frame-internal-border-width frame)))) (defun frame-outer-width (&optional frame) -- cgit v1.2.3 From b84b8dff709fd80ee124565222f333f53351ab4a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 11:54:08 +0200 Subject: Fix copying text properties in 'format' * src/editfns.c (styled_format): Fix accounting for text properties that come from the format string. (Bug#46317) * test/src/editfns-tests.el (format-properties): Add new tests for bug#46317. --- src/editfns.c | 10 +++++++++- test/src/editfns-tests.el | 22 +++++++++++++++++++++- 2 files changed, 30 insertions(+), 2 deletions(-) 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/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) -- cgit v1.2.3 From f853f2d42829326ef3606411e751b921e8ffed24 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 11:31:08 +0100 Subject: Avoid a compilation warning in iter-do * lisp/emacs-lisp/generator.el (iter-do): Avoid a compilation warning on using variables marked for not using (bug#31641). Eg. (iter-do (_ i)) --- lisp/emacs-lisp/generator.el | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index 9eb6d959645..e45260c32ac 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -725,17 +725,20 @@ Return the value with which ITERATOR finished iteration." (condition-symbol (cps--gensym "iter-do-condition")) (it-symbol (cps--gensym "iter-do-iterator")) (result-symbol (cps--gensym "iter-do-result"))) - `(let (,var - ,result-symbol + `(let (,result-symbol (,done-symbol nil) (,it-symbol ,iterator)) - (while (not ,done-symbol) - (condition-case ,condition-symbol - (setf ,var (iter-next ,it-symbol)) - (iter-end-of-sequence - (setf ,result-symbol (cdr ,condition-symbol)) - (setf ,done-symbol t))) - (unless ,done-symbol ,@body)) + (while + (let ((,var + (condition-case ,condition-symbol + (iter-next ,it-symbol) + (iter-end-of-sequence + (setf ,result-symbol (cdr ,condition-symbol)) + (setf ,done-symbol t))))) + (unless ,done-symbol + ,@body + ;; Loop until done-symbol is set. + t))) ,result-symbol))) (defvar cl--loop-args) -- cgit v1.2.3 From 293264623235fdcf672eec3f8e88e4ec7e1182e4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 11:40:00 +0100 Subject: Fix problem when ~/.mailcap had several entries for a MIME type * lisp/net/mailcap.el (mailcap-mime-info): Use all the matching entries from ~/.mailcap, not just the first (bug#46318). --- lisp/net/mailcap.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 455673b5e9f..b95cd0febcd 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -842,11 +842,11 @@ If NO-DECODE is non-nil, don't decode STRING." ;; ~/.mailcap file, then we filter out the system entries ;; and see whether we have anything left. (when mailcap-prefer-mailcap-viewers - (when-let ((user-entry - (seq-find (lambda (elem) - (eq (cdr (assq 'source elem)) 'user)) - passed))) - (setq passed (list user-entry)))) + (when-let ((user-entries + (seq-filter (lambda (elem) + (eq (cdr (assq 'source elem)) 'user)) + passed))) + (setq passed user-entries))) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) -- cgit v1.2.3 From 7a25ff767df7a323898a59531a1c518b1bc28699 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 11:46:58 +0100 Subject: Clarify the indent-rigidly doc string * lisp/indent.el (indent-rigidly): Clarify exiting the transient mode (bug#46296). --- lisp/indent.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/indent.el b/lisp/indent.el index ea71e88b8b6..ed67e1c16f7 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -212,7 +212,8 @@ It is activated by calling `indent-rigidly' interactively.") If called interactively with no prefix argument, activate a transient mode in which the indentation can be adjusted interactively by typing \\\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]. -Typing any other key deactivates the transient mode. +Typing any other key deactivates the transient mode, and this key is then +acted upon as normally. If called from a program, or interactively with prefix ARG, indent all lines starting in the region forward by ARG columns. -- cgit v1.2.3 From 23a7da9148c84dbcc228dda37c9bcebfc2a004d2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 6 Feb 2021 11:50:55 +0100 Subject: Modernize use of prompts in auth-source.el * lisp/auth-source.el (auth-source-search): Adapt docstring (auth-source-format-prompt): Remove trailing ": ". (auth-source-netrc-create, auth-source-secrets-create) (auth-source-plstore-create): Adapt prompts. Use `format-prompt'. Do not ask interactively if `auth-source-save-behavior' is nil. --- lisp/auth-source.el | 77 +++++++++++++++++++++++++---------------------------- 1 file changed, 37 insertions(+), 40 deletions(-) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 2494040457b..14cae8a52c7 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -581,14 +581,15 @@ default value. If the user, host, or port are missing, the alist `auth-source-creation-prompts' will be used to look up the prompts IN THAT ORDER (so the `user' prompt will be queried first, then `host', then `port', and finally `secret'). Each prompt string -can use %u, %h, and %p to show the user, host, and port. +can use %u, %h, and %p to show the user, host, and port. The prompt +is formatted with `format-prompt', a trailing \": \" is removed. Here's an example: \(let ((auth-source-creation-defaults \\='((user . \"defaultUser\") (A . \"default A\"))) (auth-source-creation-prompts - \\='((secret . \"Enter IMAP password for %h:%p: \")))) + \\='((secret . \"Enter IMAP password for %h:%p\")))) (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1 :P \"pppp\" :Q \"qqqq\" :create \\='(A B Q))) @@ -860,7 +861,9 @@ while \(:host t) would find all host entries." secret))) (defun auth-source-format-prompt (prompt alist) - "Format PROMPT using %x (for any character x) specifiers in ALIST." + "Format PROMPT using %x (for any character x) specifiers in ALIST. +Remove trailing \": \"." + (setq prompt (replace-regexp-in-string ":\\s-*$" "" prompt)) (dolist (cell alist) (let ((c (nth 0 cell)) (v (nth 1 cell))) @@ -1344,11 +1347,11 @@ See `auth-source-search' for details on SPEC." "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -1378,7 +1381,9 @@ See `auth-source-search' for details on SPEC." (setq check nil))) ret)) (t 'never))) - (plain (or (eval default) (read-passwd prompt)))) + (plain + (or (eval default) + (read-passwd (format-prompt prompt nil))))) ;; ask if we don't know what to do (in which case ;; auth-source-netrc-use-gpg-tokens must be a list) (unless gpg-encrypt @@ -1390,12 +1395,9 @@ See `auth-source-search' for details on SPEC." (if (eq gpg-encrypt 'gpg) (auth-source-epa-make-gpg-token plain file) plain)) - (if (stringp default) - (read-string (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (if (and (stringp default) auth-source-save-behavior) + (read-string + (format-prompt prompt default) nil nil default) (eval default))))) (when data @@ -1745,12 +1747,12 @@ authentication tokens: "[any label]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ") - (label "Enter label for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h") + (label "Enter label for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -1760,13 +1762,11 @@ authentication tokens: ;; Store the data, prompting for the password if needed. (setq data (or data (if (eq r 'secret) - (or (eval default) (read-passwd prompt)) - (if (stringp default) - (read-string (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (or (eval default) + (read-passwd (format-prompt prompt nil))) + (if (and (stringp default) auth-source-save-behavior) + (read-string + (format-prompt prompt default) nil nil default) (eval default))))) (when data @@ -2190,11 +2190,11 @@ entries for git.gnus.org: "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -2204,14 +2204,11 @@ entries for git.gnus.org: ;; Store the data, prompting for the password if needed. (setq data (or data (if (eq r 'secret) - (or (eval default) (read-passwd prompt)) - (if (stringp default) + (or (eval default) + (read-passwd (format-prompt prompt nil))) + (if (and (stringp default) auth-source-save-behavior) (read-string - (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (format-prompt prompt default) nil nil default) (eval default))))) (when data -- cgit v1.2.3 From 2476abc1f24f1b2385648cfb08cd9f178422497d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 12:03:43 +0100 Subject: Allow provided-mode-derived-p to work on aliases * lisp/subr.el (provided-mode-derived-p): Allow this to work on modes that are aliases of other modes (bug#46331). For instance: (provided-mode-derived-p 'javascript-mode 'prog-mode) --- lisp/subr.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/subr.el b/lisp/subr.el index 6e52bd20df2..c1624aa9c02 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2231,6 +2231,10 @@ Affects only hooks run in the current buffer." "Non-nil if MODE is derived from one of MODES or their aliases. Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." + ;; If MODE is an alias, then look up the real mode function first. + (when-let ((alias (symbol-function mode))) + (when (symbolp alias) + (setq mode alias))) (while (and (not (memq mode modes)) -- cgit v1.2.3 From cf0869d22bc62ae255bf5f824a02c92878c5c6cc Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 12:28:46 +0100 Subject: Rename the `1value' symbol in testcover.el * lisp/emacs-lisp/testcover.el: Rename the symbol `1value' throughout the file to `testcover-1value' to allow using the variable in code that's to be tested (bug#25471). --- lisp/emacs-lisp/testcover.el | 60 ++++++++++++++++++++++---------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 312e38769c5..50f2b51637c 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -258,10 +258,10 @@ vector. Return VALUE." (aset testcover-vector after-index (testcover--copy-object value))) ((eq 'maybe old-result) (aset testcover-vector after-index 'edebug-ok-coverage)) - ((eq '1value old-result) + ((eq 'testcover-1value old-result) (aset testcover-vector after-index (cons old-result (testcover--copy-object value)))) - ((and (eq (car-safe old-result) '1value) + ((and (eq (car-safe old-result) 'testcover-1value) (not (condition-case () (equal (cdr old-result) value) (circular-list t)))) @@ -358,11 +358,11 @@ eliminated by adding more test cases." data (aref coverage len)) (when (and (not (eq data 'edebug-ok-coverage)) (not (memq (car-safe data) - '(1value maybe noreturn))) + '(testcover-1value maybe noreturn))) (setq j (+ def-mark (aref points len)))) (setq ov (make-overlay (1- j) j)) (overlay-put ov 'face - (if (memq data '(edebug-unknown maybe 1value)) + (if (memq data '(edebug-unknown maybe testcover-1value)) 'testcover-nohits 'testcover-1value)))) (set-buffer-modified-p changed)))) @@ -450,12 +450,12 @@ or return multiple values." (`(defconst ,sym . ,args) (push sym testcover-module-constants) (testcover-analyze-coverage-progn args) - '1value) + 'testcover-1value) (`(defun ,name ,_ . ,doc-and-body) (let ((val (testcover-analyze-coverage-progn doc-and-body))) (cl-case val - ((1value) (push name testcover-module-1value-functions)) + ((testcover-1value) (push name testcover-module-1value-functions)) ((maybe) (push name testcover-module-potentially-1value-functions))) nil)) @@ -466,13 +466,13 @@ or return multiple values." ;; To avoid infinite recursion, don't examine quoted objects. ;; This will cause the coverage marks on an instrumented quoted ;; form to look odd. See bug#25316. - '1value) + 'testcover-1value) (`(\` ,bq-form) (testcover-analyze-coverage-backquote-form bq-form)) ((or 't 'nil (pred keywordp)) - '1value) + 'testcover-1value) ((pred vectorp) (testcover-analyze-coverage-compose (append form nil) @@ -482,7 +482,7 @@ or return multiple values." nil) ((pred atom) - '1value) + 'testcover-1value) (_ ;; Whatever we have here, it's not wrapped, so treat it as a list of forms. @@ -494,7 +494,7 @@ Analyze all the forms in FORMS and return 1value, maybe or nil depending on the analysis of the last one. Find the coverage vectors referenced by `edebug-enter' forms nested within FORMS and update them with the results of the analysis." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp forms) (setq result (testcover-analyze-coverage (pop forms)))) result)) @@ -516,9 +516,9 @@ form to be treated accordingly." (aset testcover-vector before-id 'edebug-ok-coverage)) (setq val (testcover-analyze-coverage-wrapped-form wrapped-form)) - (when (or (eq wrapper '1value) val) + (when (or (eq wrapper 'testcover-1value) val) ;; The form is 1-valued or potentially 1-valued. - (aset testcover-vector after-id (or val '1value))) + (aset testcover-vector after-id (or val 'testcover-1value))) (cond ((or (eq wrapper 'noreturn) @@ -526,13 +526,13 @@ form to be treated accordingly." ;; This function won't return, so indicate to testcover-before that ;; it should record coverage. (aset testcover-vector before-id (cons 'noreturn after-id)) - (aset testcover-vector after-id '1value) - (setq val '1value)) + (aset testcover-vector after-id 'testcover-1value) + (setq val 'testcover-1value)) - ((eq (car-safe wrapped-form) '1value) + ((eq (car-safe wrapped-form) 'testcover-1value) ;; This function is always supposed to return the same value. - (setq val '1value) - (aset testcover-vector after-id '1value))) + (setq val 'testcover-1value) + (aset testcover-vector after-id 'testcover-1value))) val)) (defun testcover-analyze-coverage-wrapped-form (form) @@ -540,26 +540,26 @@ form to be treated accordingly." FORM is treated as if it will be evaluated." (pcase form ((pred keywordp) - '1value) + 'testcover-1value) ((pred symbolp) (when (or (memq form testcover-constants) (memq form testcover-module-constants)) - '1value)) + 'testcover-1value)) ((pred atom) - '1value) + 'testcover-1value) (`(\` ,bq-form) (testcover-analyze-coverage-backquote-form bq-form)) (`(defconst ,sym ,val . ,_) (push sym testcover-module-constants) (testcover-analyze-coverage val) - '1value) + 'testcover-1value) (`(,(or 'dotimes 'dolist) (,_ ,expr . ,result) . ,body) ;; These always return RESULT if provided. (testcover-analyze-coverage expr) (testcover-analyze-coverage-progn body) (let ((val (testcover-analyze-coverage-progn result))) ;; If the third value is not present, the loop always returns nil. - (if result val '1value))) + (if result val 'testcover-1value))) (`(,(or 'let 'let*) ,bindings . ,body) (testcover-analyze-coverage-progn bindings) (testcover-analyze-coverage-progn body)) @@ -586,9 +586,9 @@ FORM is treated as if it will be evaluated." ;; depending on the symbol. (let ((temp-form (cons func args))) (testcover-analyze-coverage-wrapped-form temp-form))) - (`(,(and func (or '1value 'noreturn)) ,inner-form) + (`(,(and func (or 'testcover-1value 'noreturn)) ,inner-form) ;; 1value and noreturn change how the edebug-after they wrap is handled. - (let ((val (if (eq func '1value) '1value 'maybe))) + (let ((val (if (eq func 'testcover-1value) 'testcover-1value 'maybe))) (pcase inner-form (`(edebug-after ,(and before-form (or `(edebug-before ,before-id) before-id)) @@ -604,12 +604,12 @@ FORM is treated as if it will be evaluated." (defun testcover-analyze-coverage-wrapped-application (func args) "Analyze the application of FUNC to ARGS for code coverage." (cond - ((eq func 'quote) '1value) + ((eq func 'quote) 'testcover-1value) ((or (memq func testcover-1value-functions) (memq func testcover-module-1value-functions)) ;; The function should always return the same value. (testcover-analyze-coverage-progn args) - '1value) + 'testcover-1value) ((or (memq func testcover-potentially-1value-functions) (memq func testcover-module-potentially-1value-functions)) ;; The function might always return the same value. @@ -635,14 +635,14 @@ If either argument is nil, return nil, otherwise if either argument is maybe, return maybe. Return 1value only if both arguments are 1value." (cl-case val - (1value result) + (testcover-1value result) (maybe (and result 'maybe)) (nil nil))) (defun testcover-analyze-coverage-compose (forms func) "Analyze a list of FORMS for code coverage using FUNC. The list is 1valued if all of its constituent elements are also 1valued." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp forms) (setq result (testcover-coverage-combine result (funcall func (car forms)))) (setq forms (cdr forms))) @@ -652,7 +652,7 @@ The list is 1valued if all of its constituent elements are also 1valued." (defun testcover-analyze-coverage-backquote (bq-list) "Analyze BQ-LIST, the body of a backquoted list, for code coverage." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp bq-list) (let ((form (car bq-list)) val) @@ -670,7 +670,7 @@ The list is 1valued if all of its constituent elements are also 1valued." "Analyze a single FORM from a backquoted list for code coverage." (cond ((vectorp form) (testcover-analyze-coverage-backquote (append form nil))) - ((atom form) '1value) + ((atom form) 'testcover-1value) ((memq (car form) (list '\, '\,@)) (testcover-analyze-coverage (cadr form))) (t (testcover-analyze-coverage-backquote form)))) -- cgit v1.2.3 From 0100e33f83eaf1e6698c168c4118cf84a1792496 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 13:26:25 +0100 Subject: Warn in message.el when sending encryptable mail * lisp/gnus/message.el (message-send): Query if it looks like encryption was intended, but is not going to happen. * lisp/gnus/mml-sec.el (mml-secure-is-encrypted-p): Allow saying whether there's any <#secure tags present (bug#24411). --- lisp/gnus/message.el | 4 ++++ lisp/gnus/mml-sec.el | 15 +++++++++------ 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 6668784f93c..5a5dbcebc1e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4315,6 +4315,10 @@ It should typically alter the sending method in some way or other." (when message-confirm-send (or (y-or-n-p "Send message? ") (keyboard-quit))) + (when (and (not (mml-secure-is-encrypted-p)) + (mml-secure-is-encrypted-p 'anywhere) + (not (yes-or-no-p "This message has a <#secure tag, but is not going to be encrypted. Send anyway?"))) + (error "Aborting sending")) (message message-sending-message) (let ((alist message-send-method-alist) (success t) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 8d01d15ca01..d41c9dd0d9a 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -298,14 +298,17 @@ Use METHOD if given. Else use `mml-secure-method' or (interactive) (mml-secure-part "smime")) -(defun mml-secure-is-encrypted-p () - "Check whether secure encrypt tag is present." +(defun mml-secure-is-encrypted-p (&optional tag-present) + "Whether the current buffer contains a mail message that should be encrypted. +If TAG-PRESENT, say whether the <#secure tag is present anywhere +in the buffer." (save-excursion (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n" - "<#secure[^>]+encrypt") - nil t))) + (message-goto-body) + (if tag-present + (re-search-forward "<#secure[^>]+encrypt" nil t) + (skip-chars-forward "[ \t\n") + (looking-at "<#secure[^>]+encrypt")))) (defun mml-secure-bcc-is-safe () "Check whether usage of Bcc is safe (or absent). -- cgit v1.2.3 From 8ad48a0bdd0806fe3bfbabf00c845381d9107cb0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 14:31:51 +0200 Subject: Improve doc string of 'text-scale-adjust' * lisp/face-remap.el (text-scale-adjust): Clarify that "default face height" refers to the 'default' face. (Bug#25168) --- lisp/face-remap.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 49b01d02a3d..6c3f4082fdf 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -325,9 +325,9 @@ INC may be passed as a numeric prefix argument. The actual adjustment made depends on the final component of the key-binding used to invoke the command, with all modifiers removed: - +, = Increase the default face height by one step - - Decrease the default face height by one step - 0 Reset the default face height to the global default + +, = Increase the height of the default face by one step + - Decrease the height of the default face by one step + 0 Reset the height of the default face to the global default After adjusting, continue to read input events and further adjust the face height as long as the input event read -- cgit v1.2.3 From 5903db0c2049c588f6b15717a8f9bd4c6a6f46a4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 13:54:33 +0100 Subject: Tweak provided-mode-derived-p doc string * lisp/subr.el (provided-mode-derived-p): Remove detail about "or their aliases", since that seems self-evident (bug#46331) (and derived-mode-p works the same, and doesn't have the bit in question). --- lisp/subr.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/subr.el b/lisp/subr.el index c1624aa9c02..f0de6d5ac92 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2228,7 +2228,7 @@ Affects only hooks run in the current buffer." ;; PUBLIC: find if the current mode derives from another. (defun provided-mode-derived-p (mode &rest modes) - "Non-nil if MODE is derived from one of MODES or their aliases. + "Non-nil if MODE is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." ;; If MODE is an alias, then look up the real mode function first. -- cgit v1.2.3 From f534d3fdacb3d6114a0ebdc8df2723265339db5d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 15:09:32 +0200 Subject: Support file names with whitespace in Nroff mode * lisp/textmodes/nroff-mode.el (nroff-view): Quote argument of 'Man-getpage-in-background' to support file names with special characters. (Bug#46051) --- lisp/textmodes/nroff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index fe70e925b05..e7d852be3c8 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -316,7 +316,7 @@ otherwise off." (save-buffer)) (if viewbuf (kill-buffer viewbuf)) - (Man-getpage-in-background file))) + (Man-getpage-in-background (shell-quote-argument file)))) (provide 'nroff-mode) -- cgit v1.2.3 From c4a6f81ca4405a91ba04797ec5aced98c3c6decf Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 6 Feb 2021 15:04:52 +0100 Subject: Fix previous change in testcover.el * lisp/emacs-lisp/testcover.el (testcover-analyze-coverage-edebug-after): The wrapper macro is called `1value', not `testcover-1value'. --- lisp/emacs-lisp/testcover.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 50f2b51637c..75b27d08e56 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -516,7 +516,7 @@ form to be treated accordingly." (aset testcover-vector before-id 'edebug-ok-coverage)) (setq val (testcover-analyze-coverage-wrapped-form wrapped-form)) - (when (or (eq wrapper 'testcover-1value) val) + (when (or (eq wrapper '1value) val) ;; The form is 1-valued or potentially 1-valued. (aset testcover-vector after-id (or val 'testcover-1value))) @@ -529,7 +529,7 @@ form to be treated accordingly." (aset testcover-vector after-id 'testcover-1value) (setq val 'testcover-1value)) - ((eq (car-safe wrapped-form) 'testcover-1value) + ((eq (car-safe wrapped-form) '1value) ;; This function is always supposed to return the same value. (setq val 'testcover-1value) (aset testcover-vector after-id 'testcover-1value))) @@ -586,9 +586,9 @@ FORM is treated as if it will be evaluated." ;; depending on the symbol. (let ((temp-form (cons func args))) (testcover-analyze-coverage-wrapped-form temp-form))) - (`(,(and func (or 'testcover-1value 'noreturn)) ,inner-form) + (`(,(and func (or '1value 'noreturn)) ,inner-form) ;; 1value and noreturn change how the edebug-after they wrap is handled. - (let ((val (if (eq func 'testcover-1value) 'testcover-1value 'maybe))) + (let ((val (if (eq func '1value) '1value 'maybe))) (pcase inner-form (`(edebug-after ,(and before-form (or `(edebug-before ,before-id) before-id)) -- cgit v1.2.3 From 29e9cf291eb35a77ad782e56effddf2fa00ee96c Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sat, 6 Feb 2021 18:22:29 +0100 Subject: Permit zero value for 'child-frame-border-width' parameter (Bug#46184) * doc/lispref/frames.texi (Layout Parameters): Update entry on 'child-frame-border-width' parameter. * src/frame.c (make_frame): Init child_frame_border_width to -1. (Fframe_child_frame_border_width): Return internal border width if child frame border width parameter is nil. (gui_report_frame_params): Report nil as child frame border width parameter if the frame value is negative. * src/frame.h (FRAME_INTERNAL_BORDER_WIDTH): Return value of child frame border width only if it is not negative. * src/xfns.c (Fx_create_frame): Default child frame border to -1 when recording it in its frame slot via gui_default_parameter. * src/nsfns.m (ns_set_child_frame_border_width): Handle nil ARG. (Fx_create_frame): Default child frame border width parameter to nil. * src/w32fns.c (w32_set_child_frame_border_width): Handle nil ARG. (Fx_create_frame): Default child frame border width parameter to nil. * src/xfns.c (x_set_child_frame_border_width): Handle nil ARG. (Fx_create_frame): Default child frame border width parameter to nil. --- doc/lispref/frames.texi | 2 ++ src/frame.c | 16 +++++++++++++--- src/frame.h | 10 +++++----- src/nsfns.m | 25 ++++++++++++++++--------- src/w32fns.c | 30 ++++++++++++++++-------------- src/xfns.c | 36 +++++++++++++++++++----------------- 6 files changed, 71 insertions(+), 48 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a15511dc9f5..f4316b753d8 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1802,6 +1802,8 @@ Geometry}). @item child-frame-border-width The width in pixels of the frame's internal border (@pxref{Frame Geometry}) if the given frame is a child frame (@pxref{Child Frames}). +If this is @code{nil}, the value specified by the +@code{internal-border-width} parameter is used instead. @vindex vertical-scroll-bars@r{, a frame parameter} @item vertical-scroll-bars diff --git a/src/frame.c b/src/frame.c index a2167ce1e49..635fc945604 100644 --- a/src/frame.c +++ b/src/frame.c @@ -898,6 +898,7 @@ make_frame (bool mini_p) f->no_accept_focus = false; f->z_group = z_group_none; f->tooltip = false; + f->child_frame_border_width = -1; f->last_tab_bar_item = -1; #ifndef HAVE_EXT_TOOL_BAR f->last_tool_bar_item = -1; @@ -3544,10 +3545,17 @@ DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0, } DEFUN ("frame-child-frame-border-width", Fframe_child_frame_border_width, Sframe_child_frame_border_width, 0, 1, 0, - doc: /* Return width of FRAME's child-frame border in pixels. */) + doc: /* Return width of FRAME's child-frame border in pixels. + If FRAME's 'child-frame-border-width' parameter is nil, return FRAME's + internal border width instead. */) (Lisp_Object frame) { - return make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame (frame))); + int width = FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame (frame)); + + if (width < 0) + return make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame))); + else + return make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame (frame))); } DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0, @@ -4311,7 +4319,9 @@ gui_report_frame_params (struct frame *f, Lisp_Object *alistptr) store_in_alist (alistptr, Qborder_width, make_fixnum (f->border_width)); store_in_alist (alistptr, Qchild_frame_border_width, - make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (f))); + FRAME_CHILD_FRAME_BORDER_WIDTH (f) >= 0 + ? make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (f)) + : Qnil); store_in_alist (alistptr, Qinternal_border_width, make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f))); store_in_alist (alistptr, Qright_divider_width, diff --git a/src/frame.h b/src/frame.h index 21148fe94c9..9ddcb4c6810 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1449,11 +1449,11 @@ INLINE int FRAME_INTERNAL_BORDER_WIDTH (struct frame *f) { #ifdef HAVE_WINDOW_SYSTEM - return FRAME_PARENT_FRAME(f) - ? (f->child_frame_border_width - ? FRAME_CHILD_FRAME_BORDER_WIDTH(f) - : frame_dimension (f->internal_border_width)) - : frame_dimension (f->internal_border_width); + return (FRAME_PARENT_FRAME(f) + ? (FRAME_CHILD_FRAME_BORDER_WIDTH(f) >= 0 + ? FRAME_CHILD_FRAME_BORDER_WIDTH(f) + : frame_dimension (f->internal_border_width)) + : frame_dimension (f->internal_border_width)); #else return frame_dimension (f->internal_border_width); #endif diff --git a/src/nsfns.m b/src/nsfns.m index c7857eac731..5c4cc915e7c 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -690,17 +690,24 @@ 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/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), -- cgit v1.2.3 From b76864ef5513a9c1f7fe1138266dfab47f6fe350 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 6 Feb 2021 09:29:53 -0800 Subject: Fix TEXT check in gnus-search IMAP search * lisp/gnus/gnus-search.el (gnus-search-run-search): It's a string, not a buffer! --- lisp/gnus/gnus-search.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index f3e08519c3e..0783d34733a 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1040,7 +1040,7 @@ Responsible for handling and, or, and parenthetical expressions.") ;; A bit of backward-compatibility slash convenience: if the ;; query string doesn't start with any known IMAP search ;; keyword, assume it is a "TEXT" search. - (unless (or (looking-at "(") + (unless (or (eql ?\( (aref q-string 0)) (and (string-match "\\`[^[:blank:]]+" q-string) (memql (intern-soft (downcase (match-string 0 q-string))) -- cgit v1.2.3 From d640ec27183c9424daaf2d5dcb683ed1ff39d036 Mon Sep 17 00:00:00 2001 From: Ioannis Kappas Date: Wed, 3 Feb 2021 22:50:54 +0000 Subject: New test for src/process.c on MS-Windows * test/src/process-tests.el (process-sentinel-interrupt-event): New test. (Bug#46284) Copyright-paperwork-exempt: yes --- test/src/process-tests.el | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index a3fba8d328b..950d0814c2a 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -879,5 +879,34 @@ Return nil if FILENAME doesn't exist." (file-regular-p filename) filename))) +;; Bug#46284 +(ert-deftest process-sentinel-interrupt-event () + "Test that interrupting a process on MS-Windows sends the + \"interrupt\" event to the process sentinel." + (skip-unless (eq system-type 'windows-nt)) + (with-temp-buffer + (let* ((proc-buf (current-buffer)) + ;; Start a new emacs process to wait idly until interrupted. + (cmd "emacs -batch --eval=\"(sit-for 50000)\"") + (proc (start-file-process-shell-command + "test/process-sentinel-signal-event" proc-buf cmd)) + (events '())) + + ;; Capture any incoming events. + (set-process-sentinel proc + (lambda (proc event) + (push event events))) + ;; Wait for the process to start. + (sleep-for 2) + (should (equal 'run (process-status proc))) + ;; Interrupt the sub-process and wait for it to die. + (interrupt-process proc) + (sleep-for 2) + ;; Should have received SIGINT... + (should (equal 'signal (process-status proc))) + (should (equal 2 (process-exit-status proc))) + ;; ...and the change description should be "interrupt". + (should (equal '("interrupt\n") events))))) + (provide 'process-tests) ;;; process-tests.el ends here -- cgit v1.2.3 From a3b182954ccf10a0c21568bd91f7725db575690e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 20:20:31 +0200 Subject: ; Fix last change --- test/src/process-tests.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 950d0814c2a..b2e0ec19de1 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -881,8 +881,7 @@ Return nil if FILENAME doesn't exist." ;; Bug#46284 (ert-deftest process-sentinel-interrupt-event () - "Test that interrupting a process on MS-Windows sends the - \"interrupt\" event to the process sentinel." + "Test that interrupting a process on Windows sends \"interrupt\" to sentinel." (skip-unless (eq system-type 'windows-nt)) (with-temp-buffer (let* ((proc-buf (current-buffer)) -- cgit v1.2.3 From f95266ee68ab85f7a237b473f98b36413b542553 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Feb 2021 20:50:57 +0200 Subject: ; Fix byte-compilation warning * test/src/process-tests.el (process-sentinel-interrupt-event): Fix byte compilation warning. --- test/src/process-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index b2e0ec19de1..e62bcb3f7c0 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -893,7 +893,7 @@ Return nil if FILENAME doesn't exist." ;; Capture any incoming events. (set-process-sentinel proc - (lambda (proc event) + (lambda (_prc event) (push event events))) ;; Wait for the process to start. (sleep-for 2) -- cgit v1.2.3 From 83983b6b7a115474572973b62eb5e42251713e63 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 6 Feb 2021 18:34:45 +0100 Subject: Constprop of lexical variables Lexical variables bound to a constant value (symbol, number or string) are substituted at their point of use and the variable then eliminated if possible. Example: (let ((x (+ 2 3))) (f x)) => (f 5) This reduces code size, eliminates stack operations, and enables further optimisations. The implementation is conservative, and is strongly curtailed by the presence of variable mutation, conditions and loops. * lisp/emacs-lisp/byte-opt.el (byte-optimize-enable-variable-constprop) (byte-optimize-warn-eliminated-variable): New constants. (byte-optimize--lexvars, byte-optimize--vars-outside-condition) (byte-optimize--vars-outside-loop, byte-optimize--dynamic-vars): New dynamic variables. (byte-optimize--substitutable-p, byte-optimize-let-form): New functions. (byte-optimize-form-code-walker): Adapt clauses for variable constprop, and add clauses for 'setq' and 'defvar'. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-var) (bytecomp-test-get-var, bytecomp-test-identity) (byte-opt-testsuite-arith-data): Add test cases. --- lisp/emacs-lisp/byte-opt.el | 314 +++++++++++++++++++++++++-------- test/lisp/emacs-lisp/bytecomp-tests.el | 61 ++++++- 2 files changed, 304 insertions(+), 71 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 66a117fccc8..017cad900d8 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -368,6 +368,53 @@ ;;; implementing source-level optimizers +(defconst byte-optimize-enable-variable-constprop t + "If non-nil, enable constant propagation through local variables.") + +(defconst byte-optimize-warn-eliminated-variable nil + "Whether to warn when a variable is optimised away entirely. +This does usually not indicate a problem and makes the compiler +very chatty, but can be useful for debugging.") + +(defvar byte-optimize--lexvars nil + "Lexical variables in scope, in reverse order of declaration. +Each element is on the form (NAME CHANGED [VALUE]), where: + NAME is the variable name, + CHANGED is a boolean indicating whether it's been changed (with setq), + VALUE, if present, is a substitutable expression. +Earlier variables shadow later ones with the same name.") + +(defvar byte-optimize--vars-outside-condition nil + "Alist of variables lexically bound outside conditionally executed code. +Variables here are sensitive to mutation inside the condition, since such +changes may not be effective for all code paths. +Same format as `byte-optimize--lexvars', with shared structure and contents.") + +(defvar byte-optimize--vars-outside-loop nil + "Alist of variables lexically bound outside the innermost `while' loop. +Variables here are sensitive to mutation inside the loop, since this can +occur an indeterminate number of times and thus have effect on code +sequentially preceding the mutation itself. +Same format as `byte-optimize--lexvars', with shared structure and contents.") + +(defvar byte-optimize--dynamic-vars nil + "List of variables declared as dynamic during optimisation.") + +(defun byte-optimize--substitutable-p (expr) + "Whether EXPR is a constant that can be propagated." + ;; Only consider numbers, symbols and strings to be values for substitution + ;; purposes. Numbers and symbols are immutable, and mutating string + ;; literals (or results from constant-evaluated string-returning functions) + ;; can be considered undefined. + ;; (What about other quoted values, like conses?) + (or (booleanp expr) + (numberp expr) + (stringp expr) + (and (consp expr) + (eq (car expr) 'quote) + (symbolp (cadr expr))) + (keywordp expr))) + (defun byte-optimize-form-code-walker (form for-effect) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But @@ -382,11 +429,24 @@ (let ((fn (car-safe form))) (pcase form ((pred (not consp)) - (if (not (and for-effect - (or byte-compile-delete-errors - (not (symbolp form)) - (eq form t)))) - form)) + (cond + ((and for-effect + (or byte-compile-delete-errors + (not (symbolp form)) + (eq form t))) + nil) + ((symbolp form) + (let ((lexvar (assq form byte-optimize--lexvars))) + (if (cddr lexvar) ; Value available? + (if (assq form byte-optimize--vars-outside-loop) + ;; Cannot substitute; mark as changed to avoid the + ;; variable being eliminated. + (progn + (setcar (cdr lexvar) t) + form) + (caddr lexvar)) ; variable value to use + form))) + (t form))) (`(quote . ,v) (if (cdr v) (byte-compile-warn "malformed quote form: `%s'" @@ -396,33 +456,22 @@ (and (car v) (not for-effect) form)) - (`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare)) - ;; Recursively enter the optimizer for the bindings and body - ;; of a let or let*. This for depth-firstness: forms that - ;; are more deeply nested are optimized first. - (cons fn - (cons - (mapcar (lambda (binding) - (if (symbolp binding) - binding - (if (cdr (cdr binding)) - (byte-compile-warn "malformed let binding: `%s'" - (prin1-to-string binding))) - (list (car binding) - (byte-optimize-form (nth 1 binding) nil)))) - bindings) - (byte-optimize-body exps for-effect)))) + (`(,(or 'let 'let*) . ,rest) + (cons fn (byte-optimize-let-form fn rest for-effect))) (`(cond . ,clauses) - (cons fn - (mapcar (lambda (clause) - (if (consp clause) - (cons - (byte-optimize-form (car clause) nil) - (byte-optimize-body (cdr clause) for-effect)) - (byte-compile-warn "malformed cond form: `%s'" - (prin1-to-string clause)) - clause)) - clauses))) + ;; The condition in the first clause is always executed, but + ;; right now we treat all of them as conditional for simplicity. + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + (cons fn + (mapcar (lambda (clause) + (if (consp clause) + (cons + (byte-optimize-form (car clause) nil) + (byte-optimize-body (cdr clause) for-effect)) + (byte-compile-warn "malformed cond form: `%s'" + (prin1-to-string clause)) + clause)) + clauses)))) (`(progn . ,exps) ;; As an extra added bonus, this simplifies (progn ) --> . (if (cdr exps) @@ -442,35 +491,54 @@ (cons fn (byte-optimize-body exps for-effect))) (`(if ,test ,then . ,else) - `(if ,(byte-optimize-form test nil) - ,(byte-optimize-form then for-effect) - . ,(byte-optimize-body else for-effect))) + ;; The test is always executed. + (let* ((test-opt (byte-optimize-form test nil)) + ;; The THEN and ELSE branches are executed conditionally. + ;; + ;; FIXME: We are conservative here: any variable changed in the + ;; THEN branch will be barred from substitution in the ELSE + ;; branch, despite the branches being mutually exclusive. + (byte-optimize--vars-outside-condition byte-optimize--lexvars) + (then-opt (byte-optimize-form then for-effect)) + (else-opt (byte-optimize-body else for-effect))) + `(if ,test-opt ,then-opt . ,else-opt))) (`(if . ,_) (byte-compile-warn "too few arguments for `if'")) (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. - ;; Take forms off the back until we can't any more. - ;; In the future it could conceivably be a problem that the - ;; subexpressions of these forms are optimized in the reverse - ;; order, but it's ok for now. - (if for-effect - (let ((backwards (reverse exps))) - (while (and backwards - (null (setcar backwards - (byte-optimize-form (car backwards) - for-effect)))) - (setq backwards (cdr backwards))) - (if (and exps (null backwards)) - (byte-compile-log - " all subforms of %s called for effect; deleted" form)) - (and backwards - (cons fn (nreverse (mapcar #'byte-optimize-form - backwards))))) - (cons fn (mapcar #'byte-optimize-form exps)))) + ;; FIXME: We have to traverse the expressions in left-to-right + ;; order, but doing so we miss some optimisation opportunities: + ;; consider (and A B) in a for-effect context, where B => nil. + ;; Then A could be optimised in a for-effect context too. + (let ((tail exps) + (args nil)) + (when tail + ;; The first argument is always unconditional. + (push (byte-optimize-form + (car tail) (and for-effect (null (cdr tail)))) + args) + (setq tail (cdr tail)) + ;; Remaining arguments are conditional. + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + (while tail + (push (byte-optimize-form + (car tail) (and for-effect (null (cdr tail)))) + args) + (setq tail (cdr tail))))) + (cons fn (nreverse args)))) (`(while ,exp . ,exps) - `(while ,(byte-optimize-form exp nil) - . ,(byte-optimize-body exps t))) + ;; FIXME: We conservatively prevent the substitution of any variable + ;; bound outside the loop in case it is mutated later in the loop, + ;; but this misses many opportunities: variables not mutated in the + ;; loop at all, and variables affecting the initial condition (which + ;; is always executed unconditionally). + (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) + (byte-optimize--vars-outside-loop byte-optimize--lexvars) + (condition (byte-optimize-form exp nil)) + (body (byte-optimize-body exps t))) + `(while ,condition . ,body))) + (`(while . ,_) (byte-compile-warn "too few arguments for `while'")) @@ -485,24 +553,35 @@ form) (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare)) - `(condition-case ,var ;Not evaluated. - ,(byte-optimize-form exp for-effect) - ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) - clauses))) - - (`(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 +591,14 @@ `(prog1 nil . ,(mapcar #'byte-optimize-form exps))) ;; Needed as long as we run byte-optimize-form after cconv. - (`(internal-make-closure . ,_) form) + (`(internal-make-closure . ,_) + ;; Look up free vars and mark them as changed, so that they + ;; won't be optimised away. + (dolist (var (caddr form)) + (let ((lexvar (assq var byte-optimize--lexvars))) + (when lexvar + (setcar (cdr lexvar) t)))) + form) (`((lambda . ,_) . ,_) (let ((newform (byte-compile-unfold-lambda form))) @@ -525,6 +611,35 @@ ;; is a *value* and shouldn't appear in the car. (`((closure . ,_) . ,_) form) + (`(setq . ,args) + (let ((var-expr-list nil)) + (while args + (unless (and (consp args) + (symbolp (car args)) (consp (cdr args))) + (byte-compile-warn "malformed setq form: %S" form)) + (let* ((var (car args)) + (expr (cadr args)) + (lexvar (assq var byte-optimize--lexvars)) + (value (byte-optimize-form expr nil))) + (when lexvar + ;; If it's bound outside conditional, invalidate. + (if (assq var byte-optimize--vars-outside-condition) + ;; We are in conditional code and the variable was + ;; bound outside: cancel substitutions. + (setcdr (cdr lexvar) nil) + (setcdr (cdr lexvar) + (and (byte-optimize--substitutable-p value) + (list value)))) + (setcar (cdr lexvar) t)) ; Mark variable as changed. + (push var var-expr-list) + (push value var-expr-list)) + (setq args (cddr args))) + (cons fn (nreverse var-expr-list)))) + + (`(defvar ,(and (pred symbolp) name) . ,_) + (push name byte-optimize--dynamic-vars) + form) + (`(,(pred byte-code-function-p) . ,exps) (cons fn (mapcar #'byte-optimize-form exps))) @@ -582,6 +697,64 @@ new) form))) +(defun byte-optimize-let-form (head form for-effect) + ;; Recursively enter the optimizer for the bindings and body + ;; of a let or let*. This for depth-firstness: forms that + ;; are more deeply nested are optimized first. + (if (and lexical-binding byte-optimize-enable-variable-constprop) + (let* ((byte-optimize--lexvars byte-optimize--lexvars) + (new-lexvars nil) + (let-vars nil)) + (dolist (binding (car form)) + (let (name expr) + (cond ((consp binding) + (setq name (car binding)) + (unless (symbolp name) + (byte-compile-warn "let-bind nonvariable: `%S'" name)) + (setq expr (byte-optimize-form (cadr binding) nil))) + ((symbolp binding) + (setq name binding)) + (t (byte-compile-warn "malformed let binding: `%S'" binding))) + (let* ( + (value (and (byte-optimize--substitutable-p expr) + (list expr))) + (lexical (not (or (and (symbolp name) + (special-variable-p name)) + (memq name byte-compile-bound-variables) + (memq name byte-optimize--dynamic-vars)))) + (lexinfo (and lexical (cons name (cons nil value))))) + (push (cons name (cons expr (cdr lexinfo))) let-vars) + (when lexinfo + (push lexinfo (if (eq head 'let*) + byte-optimize--lexvars + new-lexvars)))))) + (setq byte-optimize--lexvars + (append new-lexvars byte-optimize--lexvars)) + ;; Walk the body expressions, which may mutate some of the records, + ;; and generate new bindings that exclude unused variables. + (let* ((opt-body (byte-optimize-body (cdr form) for-effect)) + (bindings nil)) + (dolist (var let-vars) + ;; VAR is (NAME EXPR [CHANGED [VALUE]]) + (if (and (nthcdr 3 var) (not (nth 2 var))) + (when byte-optimize-warn-eliminated-variable + (byte-compile-warn "eliminating local variable %S" (car var))) + (push (list (nth 0 var) (nth 1 var)) bindings))) + (cons bindings opt-body))) + + ;; With dynamic binding, no substitutions are in effect. + (let ((byte-optimize--lexvars nil)) + (cons + (mapcar (lambda (binding) + (if (symbolp binding) + binding + (when (or (atom binding) (cddr binding)) + (byte-compile-warn "malformed let binding: `%S'" binding)) + (list (car binding) + (byte-optimize-form (nth 1 binding) nil)))) + (car form)) + (byte-optimize-body (cdr form) for-effect))))) + (defun byte-optimize-body (forms all-for-effect) ;; Optimize the cdr of a progn or implicit progn; all forms is a list of @@ -590,6 +763,7 @@ ;; all-for-effect is true. returns a new list of forms. (let ((rest forms) (result nil) + (byte-optimize--dynamic-vars byte-optimize--dynamic-vars) fe new) (while rest (setq fe (or all-for-effect (cdr rest))) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 980b402ca2d..bc623d3efca 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -32,6 +32,15 @@ (require 'bytecomp) ;;; Code: +(defvar bytecomp-test-var nil) + +(defun bytecomp-test-get-var () + bytecomp-test-var) + +(defun bytecomp-test-identity (x) + "Identity, but hidden from some optimisations." + x) + (defconst byte-opt-testsuite-arith-data '( ;; some functional tests @@ -371,7 +380,57 @@ (assoc 'b '((a 1) (b 2) (c 3))) (assoc "b" '(("a" 1) ("b" 2) ("c" 3))) (let ((x '((a 1) (b 2) (c 3)))) (assoc 'c x)) - (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v))))) + (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v)))) + + ;; Constprop test cases + (let ((a 'alpha) (b (concat "be" "ta")) (c nil) (d t) (e :gamma) + (f '(delta epsilon))) + (list a b c d e f)) + + (let ((x 1) (y (+ 3 4))) + (list + (let (q (y x) (z y)) + (if q x (list x y z))))) + + (let* ((x 3) (y (* x 2)) (x (1+ y))) + x) + + (let ((x 1) (bytecomp-test-var 2) (y 3)) + (list x bytecomp-test-var (bytecomp-get-test-var) y)) + + (progn + (defvar d) + (let ((x 'a) (y 'b)) (list x y))) + + (let ((x 2)) + (list x (setq x 13) (setq x (* x 2)) x)) + + (let ((x 'a) (y 'b)) + (setq y x + x (cons 'c y) + y x) + (list x y)) + + (let ((x 3)) + (let ((y x) z) + (setq x 5) + (setq y (+ y 8)) + (setq z (if (bytecomp-test-identity t) + (progn + (setq x (+ x 1)) + (list x y)) + (setq x (+ x 2)) + (list x y))) + (list x y z))) + + (let ((i 1) (s 0) (x 13)) + (while (< i 5) + (setq s (+ s i)) + (setq i (1+ i))) + (list s x i)) + + (let ((x 2)) + (list (or (bytecomp-identity 'a) (setq x 3)) x))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") -- cgit v1.2.3 From 4dc3231c91c339e602f59dcfee372017b92e4318 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 4 Feb 2021 14:32:21 +0100 Subject: Fix spurious warnings from unwise condition order in inlined code These are both conditions having the form (and A B) where A is side-effect-free and B may be known to be nil at compile time. The compiler will then warn about A being useless and thrown away. The fix is to test B first. * lisp/gnus/gnus.el (gnus-method-to-server): Test `(not no-enter-cache)` first. (gnus-server-get-method): Test `group` first. --- lisp/gnus/gnus.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 84e53da297b..98664ac2b44 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3212,8 +3212,8 @@ that that variable is buffer-local to the summary buffers." (format "%s" (car method)) (format "%s:%s" (car method) (cadr method)))) (name-method (cons name method))) - (when (and (not (member name-method gnus-server-method-cache)) - (not no-enter-cache) + (when (and (not no-enter-cache) + (not (member name-method gnus-server-method-cache)) (not (assoc (car name-method) gnus-server-method-cache))) (push name-method gnus-server-method-cache)) name))) @@ -3273,8 +3273,7 @@ that that variable is buffer-local to the summary buffers." (gnus-server-to-method method)) ((equal method gnus-select-method) gnus-select-method) - ((and (stringp (car method)) - group) + ((and group (stringp (car method))) (gnus-server-extend-method group method)) ((and method (not group) -- cgit v1.2.3 From 06e1e5eeacf67b11490431c3d36700a73cf49d88 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 6 Feb 2021 22:59:00 +0200 Subject: Revert "Fix the previous change" This reverts commit fc37dc298f27025823fad2d944e11cc7ee6a058d. That change was only needed in the release branch. --- lisp/progmodes/project.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4c9b70ce043..abe563bec04 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -725,7 +725,7 @@ requires quoting, e.g. `\\[quoted-insert]'." (require 'xref) (require 'grep) (let* ((pr (project-current t)) - (default-directory (car (project-roots pr))) + (default-directory (project-root pr)) (files (if (not current-prefix-arg) (project-files pr) @@ -757,7 +757,7 @@ pattern to search for." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) - (default-directory (car (project-roots pr))) + (default-directory (project-root pr)) (files (project-files pr (cons (project-root pr) -- cgit v1.2.3 From 765ffeb54569c1679b9f08b50c6a88fe50c525c8 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 7 Feb 2021 10:35:36 +0100 Subject: ; Improved commentary in the variable constprop mechanism * lisp/emacs-lisp/byte-opt.el (byte-optimize--lexvars) (byte-optimize--vars-outside-condition) (byte-optimize-form-code-walker, byte-optimize-let-form): Clarify various aspects in the variable constant-propagation code, as kindly pointed out by Stefan Monnier. --- lisp/emacs-lisp/byte-opt.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 017cad900d8..32f66ebebb9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -378,16 +378,17 @@ very chatty, but can be useful for debugging.") (defvar byte-optimize--lexvars nil "Lexical variables in scope, in reverse order of declaration. -Each element is on the form (NAME CHANGED [VALUE]), where: +Each element is on the form (NAME KEEP [VALUE]), where: NAME is the variable name, - CHANGED is a boolean indicating whether it's been changed (with setq), + KEEP is a boolean indicating whether the binding must be retained, VALUE, if present, is a substitutable expression. Earlier variables shadow later ones with the same name.") (defvar byte-optimize--vars-outside-condition nil "Alist of variables lexically bound outside conditionally executed code. -Variables here are sensitive to mutation inside the condition, since such -changes may not be effective for all code paths. +Variables here are sensitive to mutation inside the conditional code, +since their contents in sequentially later code depends on the path taken +and may no longer be statically known. Same format as `byte-optimize--lexvars', with shared structure and contents.") (defvar byte-optimize--vars-outside-loop nil @@ -507,7 +508,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. ;; FIXME: We have to traverse the expressions in left-to-right - ;; order, but doing so we miss some optimisation opportunities: + ;; order (because that is the order of evaluation and variable + ;; mutations must be found prior to their use), but doing so we miss + ;; some optimisation opportunities: ;; consider (and A B) in a for-effect context, where B => nil. ;; Then A could be optimised in a for-effect context too. (let ((tail exps) @@ -592,7 +595,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; Needed as long as we run byte-optimize-form after cconv. (`(internal-make-closure . ,_) - ;; Look up free vars and mark them as changed, so that they + ;; Look up free vars and mark them to be kept, so that they ;; won't be optimised away. (dolist (var (caddr form)) (let ((lexvar (assq var byte-optimize--lexvars))) @@ -627,10 +630,11 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; We are in conditional code and the variable was ;; bound outside: cancel substitutions. (setcdr (cdr lexvar) nil) + ;; Set a new value (if substitutable). (setcdr (cdr lexvar) (and (byte-optimize--substitutable-p value) (list value)))) - (setcar (cdr lexvar) t)) ; Mark variable as changed. + (setcar (cdr lexvar) t)) ; Mark variable to be kept. (push var var-expr-list) (push value var-expr-list)) (setq args (cddr args))) @@ -735,8 +739,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (let* ((opt-body (byte-optimize-body (cdr form) for-effect)) (bindings nil)) (dolist (var let-vars) - ;; VAR is (NAME EXPR [CHANGED [VALUE]]) + ;; VAR is (NAME EXPR [KEEP [VALUE]]) (if (and (nthcdr 3 var) (not (nth 2 var))) + ;; Value present and not marked to be kept: eliminate. (when byte-optimize-warn-eliminated-variable (byte-compile-warn "eliminating local variable %S" (car var))) (push (list (nth 0 var) (nth 1 var)) bindings))) -- cgit v1.2.3 From 7e48430a43bbf7a2bbe347540dc346d0129df2ec Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 7 Feb 2021 12:24:40 +0100 Subject: ; * lisp/emacs-lisp/byte-opt.el: improved comment --- lisp/emacs-lisp/byte-opt.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 32f66ebebb9..abbe2a2e63f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -440,7 +440,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (let ((lexvar (assq form byte-optimize--lexvars))) (if (cddr lexvar) ; Value available? (if (assq form byte-optimize--vars-outside-loop) - ;; Cannot substitute; mark as changed to avoid the + ;; Cannot substitute; mark for retention to avoid the ;; variable being eliminated. (progn (setcar (cdr lexvar) t) -- cgit v1.2.3 From a6a5d6a27a86396ab96662fa158cdcc854bd777b Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 7 Feb 2021 13:30:33 +0100 Subject: Move 'revert-buffer' global binding to 'C-x g g' * lisp/bindings.el: Define ctl-x-g-map and bind 'revert-buffer' to 'C-x x g' globally. * doc/emacs/files.texi: Replace 'C-x g' with 'C-x x g'. * etc/NEWS: Document the change (bug#46300). --- doc/emacs/files.texi | 2 +- etc/NEWS | 2 +- lisp/bindings.el | 7 ++++++- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 12ceac800ef..6b3bc430d97 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -927,7 +927,7 @@ Manual}). For customizations, see the Custom group @code{time-stamp}. If you have made extensive changes to a file-visiting buffer and then change your mind, you can @dfn{revert} the changes and go back to -the saved version of the file. To do this, type @kbd{C-x g}. Since +the saved version of the file. To do this, type @kbd{C-x x g}. Since reverting unintentionally could lose a lot of work, Emacs asks for confirmation first. diff --git a/etc/NEWS b/etc/NEWS index fb776884701..b80c649074e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -234,7 +234,7 @@ still applies for shorter search strings, which avoids flicker in the search buffer due to too many matches being highlighted. +++ -** 'revert-buffer' is now bound to 'C-x g' globally. +** 'revert-buffer' is now bound to 'C-x x g' globally. * Editing Changes in Emacs 28.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index 9ea188d1a00..35adfa8172c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1413,7 +1413,12 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "z" 'repeat) -(define-key ctl-x-map "g" #'revert-buffer) +(defvar ctl-x-x-map + (let ((map (make-sparse-keymap))) + (define-key map "g" #'revert-buffer) + map) + "Keymap for subcommands of C-x x.") +(define-key ctl-x-map "x" ctl-x-x-map) (define-key esc-map "\C-l" 'reposition-window) -- cgit v1.2.3 From e0c9399454838444e0cc8c6c1fc1d307d9e9752b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 13:53:44 +0100 Subject: Add more commands to the new `C-x x' keymap * doc/emacs/killing.texi (Accumulating Text): * doc/emacs/display.texi (Line Truncation): * doc/emacs/buffers.texi (Misc Buffer): Document it. * lisp/bindings.el (ctl-x-x-map): Add new bindings for rename-buffer, rename-uniquely, insert-buffer and toggle-truncate-lines. --- doc/emacs/buffers.texi | 32 ++++++++++++++++---------------- doc/emacs/display.texi | 14 +++++++------- doc/emacs/killing.texi | 14 +++++++------- etc/NEWS | 6 +++++- lisp/bindings.el | 4 ++++ 5 files changed, 39 insertions(+), 31 deletions(-) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 9cdfa493ed4..3a166e404a8 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -232,9 +232,9 @@ unless they visit files: such buffers are used internally by Emacs. @table @kbd @item C-x C-q Toggle read-only status of buffer (@code{read-only-mode}). -@item M-x rename-buffer @key{RET} @var{buffer} @key{RET} +@item C-x x r @key{RET} @var{buffer} @key{RET} Change the name of the current buffer. -@item M-x rename-uniquely +@item C-x x u Rename the current buffer by adding @samp{<@var{number}>} to the end. @item M-x view-buffer @key{RET} @var{buffer} @key{RET} Scroll through buffer @var{buffer}. @xref{View Mode}. @@ -263,28 +263,28 @@ non-@code{nil} value, making the buffer read-only with @kbd{C-x C-q} also enables View mode in the buffer (@pxref{View Mode}). @findex rename-buffer - @kbd{M-x rename-buffer} changes the name of the current buffer. You -specify the new name as a minibuffer argument; there is no default. -If you specify a name that is in use for some other buffer, an error -happens and no renaming is done. + @kbd{C-x x r} (@code{rename-buffer} changes the name of the current +buffer. You specify the new name as a minibuffer argument; there is +no default. If you specify a name that is in use for some other +buffer, an error happens and no renaming is done. @findex rename-uniquely - @kbd{M-x rename-uniquely} renames the current buffer to a similar -name with a numeric suffix added to make it both different and unique. -This command does not need an argument. It is useful for creating -multiple shell buffers: if you rename the @file{*shell*} buffer, then -do @kbd{M-x shell} again, it makes a new shell buffer named -@file{*shell*}; meanwhile, the old shell buffer continues to exist -under its new name. This method is also good for mail buffers, + @kbd{C-x x u} (@code{rename-uniquely}) renames the current buffer to +a similar name with a numeric suffix added to make it both different +and unique. This command does not need an argument. It is useful for +creating multiple shell buffers: if you rename the @file{*shell*} +buffer, then do @kbd{M-x shell} again, it makes a new shell buffer +named @file{*shell*}; meanwhile, the old shell buffer continues to +exist under its new name. This method is also good for mail buffers, compilation buffers, and most Emacs features that create special buffers with particular names. (With some of these features, such as @kbd{M-x compile}, @kbd{M-x grep}, you need to switch to some other buffer before using the command again, otherwise it will reuse the current buffer despite the name change.) - The commands @kbd{M-x append-to-buffer} and @kbd{M-x insert-buffer} -can also be used to copy text from one buffer to another. -@xref{Accumulating Text}. + The commands @kbd{M-x append-to-buffer} and @kbd{C-x x i} +(@code{insert-buffer}) can also be used to copy text from one buffer +to another. @xref{Accumulating Text}. @node Kill Buffer @section Killing Buffers diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index f4b18541429..2781328cb7d 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1755,13 +1755,13 @@ and/or leftmost columns. @findex toggle-truncate-lines Horizontal scrolling automatically causes line truncation (@pxref{Horizontal Scrolling}). You can explicitly enable line -truncation for a particular buffer with the command @kbd{M-x -toggle-truncate-lines}. This works by locally changing the variable -@code{truncate-lines}. If that variable is non-@code{nil}, long lines -are truncated; if it is @code{nil}, they are continued onto multiple -screen lines. Setting the variable @code{truncate-lines} in any way -makes it local to the current buffer; until that time, the default -value, which is normally @code{nil}, is in effect. +truncation for a particular buffer with the command @kbd{C-x x t} +(@code{toggle-truncate-lines}). This works by locally changing the +variable @code{truncate-lines}. If that variable is non-@code{nil}, +long lines are truncated; if it is @code{nil}, they are continued onto +multiple screen lines. Setting the variable @code{truncate-lines} in +any way makes it local to the current buffer; until that time, the +default value, which is normally @code{nil}, is in effect. If a split window becomes too narrow, Emacs may automatically enable line truncation. @xref{Split Window}, for the variable diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 9bc786dc47b..8434040bcea 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -703,13 +703,13 @@ copy-to-buffer} is similar, except that any existing text in the other buffer is deleted, so the buffer is left containing just the text newly copied into it. - The command @kbd{M-x insert-buffer} can be used to retrieve the -accumulated text from another buffer. This prompts for the name of a -buffer, and inserts a copy of all the text in that buffer into the -current buffer at point, leaving point at the beginning of the -inserted text. It also adds the position of the end of the inserted -text to the mark ring, without activating the mark. @xref{Buffers}, -for background information on buffers. + The command @kbd{C-x x i} (@code{insert-buffer}) can be used to +retrieve the accumulated text from another buffer. This prompts for +the name of a buffer, and inserts a copy of all the text in that +buffer into the current buffer at point, leaving point at the +beginning of the inserted text. It also adds the position of the end +of the inserted text to the mark ring, without activating the mark. +@xref{Buffers}, for background information on buffers. Instead of accumulating text in a buffer, you can append text directly into a file with @kbd{M-x append-to-file}. This prompts for diff --git a/etc/NEWS b/etc/NEWS index b80c649074e..0faed3e5aa2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -234,7 +234,11 @@ still applies for shorter search strings, which avoids flicker in the search buffer due to too many matches being highlighted. +++ -** 'revert-buffer' is now bound to 'C-x x g' globally. +** A new keymap for buffer actions has been added. +The 'C-x x' keymap now holds keystrokes for various buffer-oriented +commands. The new keystrokes are 'C-x x g' ('revert-buffer'), +'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), +'C-x x i' ('insert-buffer') and 'C-x x t' ('toggle-truncate-lines'). * Editing Changes in Emacs 28.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index 35adfa8172c..9462468b1b0 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1416,6 +1416,10 @@ if `inhibit-field-text-motion' is non-nil." (defvar ctl-x-x-map (let ((map (make-sparse-keymap))) (define-key map "g" #'revert-buffer) + (define-key map "r" #'rename-buffer) + (define-key map "u" #'rename-uniquely) + (define-key map "i" #'insert-buffer) + (define-key map "t" #'toggle-truncate-lines) map) "Keymap for subcommands of C-x x.") (define-key ctl-x-map "x" ctl-x-x-map) -- cgit v1.2.3 From a1a31ecb4027a831eb81728bf66fbd44a28d2840 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 14:47:09 +0100 Subject: Clarify that #s(hash-table ...) doesn't always create a new hash table * doc/lispref/hash.texi (Creating Hash): Note that the printed representation doesn't necessarily create a new table (bug#23417). * doc/lispref/lists.texi (Rearrangement): Link to Self-Evaluating Forms to further expand upon immutability. --- doc/lispref/hash.texi | 9 +++++++-- doc/lispref/lists.texi | 15 ++++++++------- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 8781fad30cd..12c6a659079 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -150,11 +150,11 @@ multiplied by an approximation to this value. The default for @end table @end defun -You can also create a new hash table using the printed representation +You can also create a hash table using the printed representation for hash tables. The Lisp reader can read this printed representation, provided each element in the specified hash table has a valid read syntax (@pxref{Printed Representation}). For instance, -the following specifies a new hash table containing the keys +the following specifies a hash table containing the keys @code{key1} and @code{key2} (both symbols) associated with @code{val1} (a symbol) and @code{300} (a number) respectively. @@ -162,6 +162,11 @@ the following specifies a new hash table containing the keys #s(hash-table size 30 data (key1 val1 key2 300)) @end example +Note, however, that when using this in Emacs Lisp code, it's +undefined whether this creates a new hash table or not. If you want +to create a new hash table, you should always use +@code{make-hash-table} (@pxref{Self-Evaluating Forms}). + @noindent The printed representation for a hash table consists of @samp{#s} followed by a list beginning with @samp{hash-table}. The rest of the diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index c54496f6168..2805b1f5fdc 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1168,13 +1168,14 @@ x @end group @end example -However, the other arguments (all but the last) should be mutable lists. - -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 -- cgit v1.2.3 From 5beddcd325e8ec16a6f284ef0524fb796fe07d5e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 15:07:21 +0100 Subject: Reverse customize-changed and customize-changed-options aliasing * lisp/cus-edit.el (customize-changed): Rename from customize-changed-options (bug#23085), since the old name doesn't reflect what it does: It's not just about user options, but also faces and the like. (customize-changed-options): Make into an obsolete alias. --- lisp/cus-edit.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index e52df4e6a2c..cd1ae964eb9 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1242,10 +1242,11 @@ the user might see the value in an error message, a good choice is the official name of the package, such as MH-E or Gnus.") ;;;###autoload -(defalias 'customize-changed 'customize-changed-options) +(define-obsolete-function-alias 'customize-changed-options + #'customize-changed "28.1") ;;;###autoload -(defun customize-changed-options (&optional since-version) +(defun customize-changed (&optional since-version) "Customize all settings whose meanings have changed in Emacs itself. This includes new user options and faces, and new customization groups, as well as older options and faces whose meanings or -- cgit v1.2.3 From 5ffc55d1e98d04b035c3d8d88d678b74af7a1fd7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 15:12:15 +0100 Subject: Revert "Fix inferior octave single-quote font lock" This reverts commit 9e68413c7f0a7f71e1cee923ace7282d14c2e686. This patch led to bug#46327: x = [2 2]' disp(x) Which meant that the transpose operator was interpreted as the start of a string. --- lisp/progmodes/octave.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index cb44b72fb44..ddcc6f5450e 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -165,7 +165,7 @@ parenthetical grouping.") (modify-syntax-entry ?| "." table) (modify-syntax-entry ?! "." table) (modify-syntax-entry ?\\ "." table) - (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?\' "." table) (modify-syntax-entry ?\` "." table) (modify-syntax-entry ?. "." table) (modify-syntax-entry ?\" "\"" table) -- cgit v1.2.3 From 4e8d36fdaadade020f0bcadc70d617d8b07b739c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Feb 2021 15:53:46 +0100 Subject: Various doc fixes in dictionary.el * lisp/net/dictionary.el (dictionary-set-server-var) (dictionary-server, dictionary-port) (dictionary-default-dictionary) (dictionary-default-popup-strategy, dictionary-proxy-server) (dictionary-proxy-port, dictionary-description-open-delimiter) (dictionary-description-close-delimiter) (dictionary-window-configuration, dictionary-selected-window) (dictionary-position-stack, dictionary-data-stack) (dictionary-positions, dictionary-current-data) (dictionary-connection, dictionary-instances) (dictionary-color-support, dictionary-word-history) (dictionary-mode, dictionary, dictionary-check-connection) (dictionary-mode-p, dictionary-send-command) (dictionary-read-reply-and-split, dictionary-check-reply) (dictionary-check-initial-reply, dictionary-store-state) (dictionary-store-positions, dictionary-new-search) (dictionary-new-search-internal, dictionary-do-search) (dictionary-display-search-result) (dictionary-display-word-definition) (dictionary-special-dictionary, dictionary-set-strategy) (dictionary-tooltip-dictionary, dictionary-switch-tooltip-mode) (dictionary-tooltip-mode, global-dictionary-tooltip-mode): Doc fixes to adhere to our conventions. --- lisp/net/dictionary.el | 124 +++++++++++++++++++++++-------------------------- 1 file changed, 58 insertions(+), 66 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index f8733429e94..7af8cdc59b2 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -46,7 +46,7 @@ (defun dictionary-set-server-var (name value) "Customize helper for setting variable NAME to VALUE. The helper is used by customize to check for an active connection -when setting a variable. The user has then the choice to close +when setting a variable. The user has then the choice to close the existing connection." (if (and (boundp 'dictionary-connection) dictionary-connection @@ -73,8 +73,7 @@ You can specify here: - Automatic: First try localhost, then dict.org after confirmation - localhost: Only use localhost - dict.org: Only use dict.org -- User-defined: You can specify your own server here -" +- User-defined: You can specify your own server here" :group 'dictionary :set 'dictionary-set-server-var :type '(choice (const :tag "Automatic" nil) @@ -86,7 +85,7 @@ You can specify here: (defcustom dictionary-port 2628 "The port of the dictionary server. - This port is propably always 2628 so there should be no need to modify it." +This port is propably always 2628 so there should be no need to modify it." :group 'dictionary :set 'dictionary-set-server-var :type 'number @@ -102,8 +101,8 @@ You can specify here: (defcustom dictionary-default-dictionary "*" "The dictionary which is used for searching definitions and matching. - * and ! have a special meaning, * search all dictionaries, ! search until - one dictionary yields matches." +* and ! have a special meaning, * search all dictionaries, ! search until +one dictionary yields matches." :group 'dictionary :type 'string :version "28.1") @@ -144,8 +143,7 @@ by the choice value: - User choice Here you can enter any matching algorithm supported by your - dictionary server. -" + dictionary server." :group 'dictionary :type '(choice (const :tag "Exact match" "exact") (const :tag "Similiar sounding" "soundex") @@ -177,7 +175,7 @@ by the choice value: (defcustom dictionary-proxy-server "proxy" - "The name of the HTTP proxy to use when dictionary-use-http-proxy is set." + "The name of the HTTP proxy to use when `dictionary-use-http-proxy' is set." :group 'dictionary-proxy :set 'dictionary-set-server-var :type 'string @@ -185,7 +183,7 @@ by the choice value: (defcustom dictionary-proxy-port 3128 - "The port of the proxy server, used only when dictionary-use-http-proxy is set." + "The port of the proxy server, used only when `dictionary-use-http-proxy' is set." :group 'dictionary-proxy :set 'dictionary-set-server-var :type 'number @@ -200,14 +198,14 @@ by the choice value: (defcustom dictionary-description-open-delimiter "" - "The delimiter to display in front of the dictionaries description" + "The delimiter to display in front of the dictionaries description." :group 'dictionary :type 'string :version "28.1") (defcustom dictionary-description-close-delimiter "" - "The delimiter to display after of the dictionaries description" + "The delimiter to display after of the dictionaries description." :group 'dictionary :type 'string :version "28.1") @@ -283,27 +281,27 @@ is utf-8" (defvar dictionary-window-configuration nil - "The window configuration to be restored upon closing the buffer") + "The window configuration to be restored upon closing the buffer.") (defvar dictionary-selected-window nil - "The currently selected window") + "The currently selected window.") (defvar dictionary-position-stack nil - "The history buffer for point and window position") + "The history buffer for point and window position.") (defvar dictionary-data-stack nil - "The history buffer for functions and arguments") + "The history buffer for functions and arguments.") (defvar dictionary-positions nil - "The current positions") + "The current positions.") (defvar dictionary-current-data nil - "The item that will be placed on stack next time") + "The item that will be placed on stack next time.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Global variables @@ -330,11 +328,11 @@ is utf-8" (defvar dictionary-connection nil - "The current network connection") + "The current network connection.") (defvar dictionary-instances 0 - "The number of open dictionary buffers") + "The number of open dictionary buffers.") (defvar dictionary-marker nil @@ -344,11 +342,11 @@ is utf-8" (condition-case nil (x-display-color-p) (error nil)) - "Determines if the Emacs has support to display color") + "Determines if the Emacs has support to display color.") (defvar dictionary-word-history '() - "History list of searched word") + "History list of searched word.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic function providing startup actions @@ -356,25 +354,25 @@ is utf-8" ;;;###autoload (defun dictionary-mode () + ;; FIXME: Use define-derived-mode. "Mode for searching a dictionary. This is a mode for searching a dictionary server implementing the protocol defined in RFC 2229. This is a quick reference to this mode describing the default key bindings: +\\ +* \\[dictionary-close] close the dictionary buffer +* \\[dictionary-help] display this help information +* \\[dictionary-search] ask for a new word to search +* \\[dictionary-lookup-definition] search the word at point +* \\[forward-button] or TAB place point to the next link +* \\[backward-button] or S-TAB place point to the prev link -* q close the dictionary buffer -* h display this help information -* s ask for a new word to search -* d search the word at point -* n or Tab place point to the next link -* p or S-Tab place point to the prev link +* \\[dictionary-match-words] ask for a pattern and list all matching words. +* \\[dictionary-select-dictionary] select the default dictionary +* \\[dictionary-select-strategy] select the default search strategy -* m ask for a pattern and list all matching words. -* D select the default dictionary -* M select the default search strategy - -* Return or Button2 visit that link -" +* RET or visit that link" (unless (eq major-mode 'dictionary-mode) (cl-incf dictionary-instances)) @@ -399,7 +397,7 @@ This is a quick reference to this mode describing the default key bindings: ;;;###autoload (defun dictionary () - "Create a new dictonary buffer and install dictionary-mode." + "Create a new dictonary buffer and install `dictionary-mode'." (interactive) (let ((buffer (or (and dictionary-use-single-buffer (get-buffer "*Dictionary*")) @@ -498,13 +496,13 @@ The connection takes the proxy setting in customization group (dictionary-open-server server) (error (if (y-or-n-p - (format "Failed to open server %s, continue with dict.org?" + (format "Failed to open server %s, continue with dict.org? " server)) (dictionary-open-server "dict.org") (error "Failed automatic server selection, please customize dictionary-server")))))))) (defun dictionary-mode-p () - "Return non-nil if current buffer has dictionary-mode." + "Return non-nil if current buffer has `dictionary-mode'." (eq major-mode 'dictionary-mode)) (defun dictionary-ensure-buffer () @@ -535,7 +533,7 @@ The connection takes the proxy setting in customization group ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-send-command (string) - "Send the command `string' to the network connection." + "Send the command STRING to the network connection." (dictionary-check-connection) ;;;; ##### (dictionary-connection-send-crlf dictionary-connection string)) @@ -566,7 +564,7 @@ This function knows about the special meaning of quotes (\")" (nreverse list))) (defun dictionary-read-reply-and-split () - "Reads the reply, splits it into words and returns it." + "Read the reply, split it into words and return it." (let ((answer (make-symbol "reply-data")) (reply (dictionary-read-reply))) (let ((reply-list (dictionary-split-string reply))) @@ -589,7 +587,7 @@ The answer is delimited by a decimal point (.) on a line by itself." answer)) (defun dictionary-check-reply (reply code) - "Extract the reply code from REPLY and checks against CODE." + "Extract the reply code from REPLY and check against CODE." (let ((number (dictionary-reply-code reply))) (and (numberp number) (= number code)))) @@ -623,7 +621,7 @@ The answer is delimited by a decimal point (.) on a line by itself." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-check-initial-reply () - "Reads the first reply from server and checks it." + "Read the first reply from server and check it." (let ((reply (dictionary-read-reply-and-split))) (unless (dictionary-check-reply reply 220) (dictionary-connection-close dictionary-connection) @@ -631,9 +629,9 @@ The answer is delimited by a decimal point (.) on a line by itself." ;; Store the current state (defun dictionary-store-state (function data) - "Stores the current state of operation for later restore. -The current state consist of a tuple of FUNCTION and DATA. This -is basically an implementation of a history to return to a + "Store the current state of operation for later restore. +The current state consist of a tuple of FUNCTION and DATA. +This is basically an implementation of a history to return to a previous state." (if dictionary-current-data (progn @@ -645,7 +643,7 @@ previous state." (cons function data))) (defun dictionary-store-positions () - "Stores the current positions for later restore." + "Store the current positions for later restore." (setq dictionary-positions (cons (point) (window-start)))) @@ -664,7 +662,7 @@ previous state." ;; The normal search (defun dictionary-new-search (args &optional all) - "Saves the current state and starts a new search based on ARGS. + "Save the current state and start a new search based on ARGS. The parameter ARGS is a cons cell where car is the word to search and cdr is the dictionary where to search the word in." (interactive) @@ -680,15 +678,14 @@ and cdr is the dictionary where to search the word in." (list word dictionary 'dictionary-display-search-result)))) (defun dictionary-new-search-internal (word dictionary function) - "Starts a new search for WORD in DICTIONARY after preparing the buffer. -FUNCTION is the callback which is called for each search result. -" + "Start a new search for WORD in DICTIONARY after preparing the buffer. +FUNCTION is the callback which is called for each search result." (dictionary-pre-buffer) (dictionary-do-search word dictionary function)) (defun dictionary-do-search (word dictionary function &optional nomatching) - "Searches WORD in DICTIONARY and calls FUNCTION for each result. -The parameter NOMATCHING controls whether to suppress the display + "Search for WORD in DICTIONARY and call FUNCTION for each result. +Optional argument NOMATCHING controls whether to suppress the display of matching words." (message "Searching for %s in %s" word dictionary) @@ -712,7 +709,7 @@ of matching words." 'dictionary-display-only-match-result) (dictionary-post-buffer))) (if (dictionary-check-reply reply 550) - (error "Dictionary \"%s\" is unknown, please select an existing one." + (error "Dictionary \"%s\" is unknown, please select an existing one" dictionary) (unless (dictionary-check-reply reply 150) (error "Unknown server answer: %s" (dictionary-reply reply))) @@ -776,7 +773,7 @@ of matching words." (setq buffer-read-only t)) (defun dictionary-display-search-result (reply) - "This function starts displaying the result in REPLY." + "Start displaying the result in REPLY." (let ((number (nth 1 (dictionary-reply-list reply)))) (insert number (if (equal number "1") @@ -810,8 +807,7 @@ The DICTIONARY is only used for decoding the bytes to display the DESCRIPTION." (defun dictionary-display-word-definition (reply word dictionary) "Insert the definition in REPLY for the current WORD from DICTIONARY. It will replace links which are found in the REPLY and replace -them with buttons to perform a a new search. -" +them with buttons to perform a a new search." (let ((start (point))) (insert (dictionary-decode-charset reply dictionary)) (insert "\n\n") @@ -931,7 +927,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (message "Dictionary %s has been selected" dictionary)))) (defun dictionary-special-dictionary (name) - "Checks whether the special * or ! dictionary are seen in NAME." + "Check whether the special * or ! dictionary are seen in NAME." (or (equal name "*") (equal name "!"))) @@ -1011,7 +1007,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) - "Select this STRATEGY as new default" + "Select this STRATEGY as new default." (setq dictionary-default-strategy strategy) (dictionary-restore-state) (message "Strategy %s has been selected" strategy)) @@ -1234,7 +1230,7 @@ allows editing it." (defcustom dictionary-tooltip-dictionary nil - "This dictionary to lookup words for tooltips" + "This dictionary to lookup words for tooltips." :group 'dictionary :type '(choice (const :tag "None" nil) string) :version "28.1") @@ -1296,8 +1292,7 @@ It is normally internally called with 1 to enable support for the tooltip mode. The hook function will check the value of the variable dictionary-tooltip-mode to decide if some action must be taken. When disabling the tooltip mode the value of this variable -will be set to nil. -" +will be set to nil." (interactive) (tooltip-mode on) (if on @@ -1309,10 +1304,8 @@ will be set to nil. "Display tooltips for the current word. This function can be used to enable or disable the tooltip mode -for the current buffer (based on ARG). If global-tooltip-mode is -active it will overwrite that mode for the current buffer. -" - +for the current buffer (based on ARG). If global-tooltip-mode is +active it will overwrite that mode for the current buffer." (interactive "P") (require 'tooltip) (let ((on (if arg @@ -1335,8 +1328,7 @@ Internally it provides a default for the dictionary-tooltip-mode. It can be overwritten for each buffer using dictionary-tooltip-mode. Note: (global-dictionary-tooltip-mode 0) will not disable the mode -any buffer where (dictionary-tooltip-mode 1) has been called. -" +any buffer where (dictionary-tooltip-mode 1) has been called." (interactive "P") (require 'tooltip) (let ((on (if arg (> (prefix-numeric-value arg) 0) -- cgit v1.2.3 From 094a109b8eefbabbc99dba925ebec9887c101a91 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 16:02:56 +0100 Subject: Add a new function 'line-number-at-position' * doc/lispref/positions.texi (Text Lines): Document it. * lisp/simple.el (count-lines): Use it. (line-number-at-pos): Ditto. * src/fns.c (Fline_number_at_position): New function (bug#22763). --- doc/lispref/positions.texi | 18 ++++++++++-------- etc/NEWS | 4 ++++ lisp/simple.el | 17 ++++++----------- src/fns.c | 18 ++++++++++++++++++ test/src/fns-tests.el | 8 ++++++++ 5 files changed, 46 insertions(+), 19 deletions(-) diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index dc0c7442d8d..9adce21baec 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -437,16 +437,18 @@ prints a message reporting the number of lines, words, and characters in the buffer, or in the region if the region is active. @end deffn +@defun line-number-at-position pos +This function returns the line number in the current buffer +corresponding to the buffer position @var{pos}. If narrowing is in +effect, this is the line number in the visible part of the buffer. +@end defun + @defun line-number-at-pos &optional pos absolute @cindex line number -This function returns the line number in the current buffer -corresponding to the buffer position @var{pos}. If @var{pos} is -@code{nil} or omitted, the current buffer position is used. If -@var{absolute} is @code{nil}, the default, counting starts at -@code{(point-min)}, so the value refers to the contents of the -accessible portion of the (potentially narrowed) buffer. If -@var{absolute} is non-@code{nil}, ignore any narrowing and return -the absolute line number. +This function is like @code{line-number-at-position}, but if @var{pos} +is @code{nil} or omitted, the current buffer position is used. In +addition, if @var{absolute} is non-@code{nil}, ignore any narrowing +and return the absolute line number. @end defun @ignore diff --git a/etc/NEWS b/etc/NEWS index 0faed3e5aa2..93a60bf14cf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2192,6 +2192,10 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 ++++ +** New function 'line-number-at-position'. +This returns the line number in the visible portion of the buffer. + --- ** New variable 'indent-line-ignored-functions'. This allows modes to cycle through a set of indentation functions diff --git a/lisp/simple.el b/lisp/simple.el index e4a363a9a59..eab2ac25691 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1472,7 +1472,7 @@ included in the count." (assq prop buffer-invisibility-spec))) (setq invisible-count (1+ invisible-count)))) invisible-count)))) - (t (- (buffer-size) (forward-line (buffer-size)))))))) + (t (1- (line-number-at-position (point-max)))))))) (defun line-number-at-pos (&optional pos absolute) "Return buffer line number at position POS. @@ -1483,16 +1483,11 @@ at (point-min), so the value refers to the contents of the accessible portion of the (potentially narrowed) buffer. If ABSOLUTE is non-nil, ignore any narrowing and return the absolute line number." - (save-restriction - (when absolute - (widen)) - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point))))))) + (if absolute + (save-restriction + (widen) + (line-number-at-position (or pos (point)))) + (line-number-at-position (or pos (point))))) (defcustom what-cursor-show-names nil "Whether to show character names in `what-cursor-position'." diff --git a/src/fns.c b/src/fns.c index bd4afa0c4e9..479a5975ce7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5758,6 +5758,23 @@ in OBJECT. */) traverse_intervals (intervals, 0, collect_interval, collector); return CDR (collector); } + +DEFUN ("line-number-at-position", Fline_number_at_position, + Sline_number_at_position, 1, 1, 0, + doc: /* Return the line number at POSITION. +If the buffer is narrowed, the position returned is the position in the +visible part of the buffer. */) + (register Lisp_Object position) +{ + CHECK_FIXNUM (position); + ptrdiff_t pos = XFIXNUM (position); + + /* Check that POSITION is n the visible range of the buffer. */ + if (pos < BEGV || pos > ZV) + args_out_of_range (make_int (BEGV), make_int (ZV)); + + return make_int (count_lines (BEGV_BYTE, CHAR_TO_BYTE (pos)) + 1); +} void @@ -5800,6 +5817,7 @@ syms_of_fns (void) defsubr (&Sdefine_hash_table_test); defsubr (&Sstring_search); defsubr (&Sobject_intervals); + defsubr (&Sline_number_at_position); /* Crypto and hashing stuff. */ DEFSYM (Qiv_auto, "iv-auto"); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index e0aed2a71b6..3a43142106b 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1098,3 +1098,11 @@ (goto-char (point-max)) (insert "fóo") (should (approx-equal (buffer-line-statistics) '(1002 50 49.9))))) + +(ert-deftest test-line-number-at-position () + (with-temp-buffer + (insert (make-string 10 ?\n)) + (should (= (line-number-at-position (point)) 11)) + (should-error (line-number-at-position nil)) + (should-error (line-number-at-position -1)) + (should-error (line-number-at-position 100)))) -- cgit v1.2.3 From e027842f4fb57afbcd117409be12de916b0a1878 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Feb 2021 16:02:30 +0100 Subject: Fix copyright and license statement in dictionary*.el * lisp/net/dictionary-connection.el: * lisp/net/dictionary.el: Add copyright statement and fix license statement. --- lisp/net/dictionary-connection.el | 16 +++++++++------- lisp/net/dictionary.el | 16 +++++++++------- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index d88c0b48f93..2404a361714 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -1,22 +1,24 @@ ;;; dictionary-connection.el --- TCP-based client connection for dictionary -*- lexical-binding:t -*- +;; Copyright (C) 2021 Free Software Foundation, Inc. + ;; Author: Torsten Hilbrich ;; Keywords: network -;; This file is free software; you can redistribute it and/or modify +;; 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 . ;;; Commentary: diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 7af8cdc59b2..ccc24cbf303 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1,22 +1,24 @@ ;;; dictionary.el --- Client for rfc2229 dictionary servers -*- lexical-binding:t -*- +;; Copyright (C) 2021 Free Software Foundation, Inc. + ;; Author: Torsten Hilbrich ;; Keywords: interface, dictionary -;; This file is free software; you can redistribute it and/or modify +;; 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 . ;;; Commentary: -- cgit v1.2.3 From 5a4d50dfb136080fa2353461ee888d552da44a29 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Feb 2021 16:06:06 +0100 Subject: Minor doc fixes in dictionary-connection.el * lisp/net/dictionary-connection.el: (dictionary-connection-p, dictionary-connection-read-to-point): Minor doc fixes to adhere to our conventions. --- lisp/net/dictionary-connection.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index 2404a361714..8ad4fe4e637 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -23,14 +23,14 @@ ;;; Commentary: ;; dictionary-connection allows to handle TCP-based connections in -;; client mode where text-based information are exchanged. There is +;; client mode where text-based information are exchanged. There is ;; special support for handling CR LF (and the usual CR LF . CR LF ;; terminater). ;;; Code: (defsubst dictionary-connection-p (connection) - "Returns non-nil if CONNECTION is a connection object." + "Return non-nil if CONNECTION is a connection object." (get connection 'connection)) (defsubst dictionary-connection-read-point (connection) @@ -149,8 +149,7 @@ nil: argument is no connection object (defun dictionary-connection-read-to-point (connection) "Read from CONNECTION until an end of entry is encountered. -End of entry is a decimal point found on a line by itself. -" +End of entry is a decimal point found on a line by itself." (dictionary-connection-read connection "\015?\012[.]\015?\012")) (provide 'dictionary-connection) -- cgit v1.2.3 From 56e76f0eb00d92b49ddd5757d0a68d09dc522d39 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 16:28:30 +0100 Subject: Move line-number-at-pos to C * doc/lispref/positions.texi (Text Lines): Revert previous change. * lisp/simple.el (line-number-at-pos): Remove definition. * lisp/simple.el (count-lines): Revert back to using `forward-line', because there seems to be a disagreement on how lines should be counted in a region... * src/fns.c (Fline_number_at_pos): Rename from Fline_number_at_position and adjust parameter list. --- doc/lispref/positions.texi | 18 ++++++++---------- etc/NEWS | 4 ---- lisp/simple.el | 17 +---------------- src/fns.c | 31 ++++++++++++++++++++++--------- test/src/fns-tests.el | 8 ++++---- 5 files changed, 35 insertions(+), 43 deletions(-) diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 9adce21baec..dc0c7442d8d 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -437,18 +437,16 @@ prints a message reporting the number of lines, words, and characters in the buffer, or in the region if the region is active. @end deffn -@defun line-number-at-position pos -This function returns the line number in the current buffer -corresponding to the buffer position @var{pos}. If narrowing is in -effect, this is the line number in the visible part of the buffer. -@end defun - @defun line-number-at-pos &optional pos absolute @cindex line number -This function is like @code{line-number-at-position}, but if @var{pos} -is @code{nil} or omitted, the current buffer position is used. In -addition, if @var{absolute} is non-@code{nil}, ignore any narrowing -and return the absolute line number. +This function returns the line number in the current buffer +corresponding to the buffer position @var{pos}. If @var{pos} is +@code{nil} or omitted, the current buffer position is used. If +@var{absolute} is @code{nil}, the default, counting starts at +@code{(point-min)}, so the value refers to the contents of the +accessible portion of the (potentially narrowed) buffer. If +@var{absolute} is non-@code{nil}, ignore any narrowing and return +the absolute line number. @end defun @ignore diff --git a/etc/NEWS b/etc/NEWS index 93a60bf14cf..0faed3e5aa2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2192,10 +2192,6 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 -+++ -** New function 'line-number-at-position'. -This returns the line number in the visible portion of the buffer. - --- ** New variable 'indent-line-ignored-functions'. This allows modes to cycle through a set of indentation functions diff --git a/lisp/simple.el b/lisp/simple.el index eab2ac25691..73e3fb9f847 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1472,22 +1472,7 @@ included in the count." (assq prop buffer-invisibility-spec))) (setq invisible-count (1+ invisible-count)))) invisible-count)))) - (t (1- (line-number-at-position (point-max)))))))) - -(defun line-number-at-pos (&optional pos absolute) - "Return buffer line number at position POS. -If POS is nil, use current buffer location. - -If ABSOLUTE is nil, the default, counting starts -at (point-min), so the value refers to the contents of the -accessible portion of the (potentially narrowed) buffer. If -ABSOLUTE is non-nil, ignore any narrowing and return the -absolute line number." - (if absolute - (save-restriction - (widen) - (line-number-at-position (or pos (point)))) - (line-number-at-position (or pos (point))))) + (t (- (buffer-size) (forward-line (buffer-size)))))))) (defcustom what-cursor-show-names nil "Whether to show character names in `what-cursor-position'." diff --git a/src/fns.c b/src/fns.c index 479a5975ce7..d27f63222c4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5759,21 +5759,34 @@ in OBJECT. */) return CDR (collector); } -DEFUN ("line-number-at-position", Fline_number_at_position, - Sline_number_at_position, 1, 1, 0, +DEFUN ("line-number-at-pos", Fline_number_at_pos, + Sline_number_at_pos, 0, 2, 0, doc: /* Return the line number at POSITION. +If POSITION is nil, use the current buffer location. + If the buffer is narrowed, the position returned is the position in the -visible part of the buffer. */) - (register Lisp_Object position) +visible part of the buffer. If ABSOLUTE is non-nil, count the lines +from the absolute start of the buffer. */) + (register Lisp_Object position, Lisp_Object absolute) { - CHECK_FIXNUM (position); - ptrdiff_t pos = XFIXNUM (position); + ptrdiff_t pos, start = BEGV; + + if (NILP (position)) + pos = PT; + else + { + CHECK_FIXNUM (position); + pos = XFIXNUM (position); + } + + if (!NILP (absolute)) + start = BEG_BYTE; /* Check that POSITION is n the visible range of the buffer. */ if (pos < BEGV || pos > ZV) - args_out_of_range (make_int (BEGV), make_int (ZV)); + args_out_of_range (make_int (start), make_int (ZV)); - return make_int (count_lines (BEGV_BYTE, CHAR_TO_BYTE (pos)) + 1); + return make_int (count_lines (start, CHAR_TO_BYTE (pos)) + 1); } @@ -5817,7 +5830,7 @@ syms_of_fns (void) defsubr (&Sdefine_hash_table_test); defsubr (&Sstring_search); defsubr (&Sobject_intervals); - defsubr (&Sline_number_at_position); + defsubr (&Sline_number_at_pos); /* Crypto and hashing stuff. */ DEFSYM (Qiv_auto, "iv-auto"); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3a43142106b..928fb15f109 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1102,7 +1102,7 @@ (ert-deftest test-line-number-at-position () (with-temp-buffer (insert (make-string 10 ?\n)) - (should (= (line-number-at-position (point)) 11)) - (should-error (line-number-at-position nil)) - (should-error (line-number-at-position -1)) - (should-error (line-number-at-position 100)))) + (should (= (line-number-at-pos (point)) 11)) + (should (= (line-number-at-pos nil) 11)) + (should-error (line-number-at-pos -1)) + (should-error (line-number-at-pos 100)))) -- cgit v1.2.3 From 5461808c40ea5baeade203c0a4cc8200855eb00c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 16:42:25 +0100 Subject: Allow Fline_number_at_pos being called with a marker * src/fns.c (Fline_number_at_pos): Also allow being called with a marker (since the Lisp function allowed that). --- src/fns.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index d27f63222c4..02743c62a57 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5771,7 +5771,9 @@ from the absolute start of the buffer. */) { ptrdiff_t pos, start = BEGV; - if (NILP (position)) + if (MARKERP (position)) + pos = marker_position (position); + else if (NILP (position)) pos = PT; else { -- cgit v1.2.3 From 9380a7ed906e667df4fc5b9d9c8e487fafa7c654 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Sun, 7 Feb 2021 16:51:07 +0100 Subject: Add command to recenter errors from Occur/Grep buffers To scroll up/down the current displayed occurrence/error without abandon the Occur/Grep buffer. Add also a command 'recenter-other-window' to recenter the other window from any kind of buffer. * lisp/window.el (recenter-other-window): New command. Bind recenter-other-window to S-M-C-l (Bug#46119). * lisp/simple.el (recenter-current-error): New command. * lisp/progmodes/grep.el (grep-mode-map): Delete bidings for n and p. * lisp/progmodes/compile.el (compilation-minor-mode-map): Move here the n and p bindings. Bind `recenter-current-error' to l. * lisp/replace.el (occur-mode-map): Same. * doc/emacs/windows.texi (Other Window): * doc/emacs/display.texi (Recentering): Document recenter-other-window. * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 28.1): Announce the changes. --- doc/emacs/display.texi | 4 ++++ doc/emacs/windows.texi | 8 +++++++- etc/NEWS | 13 +++++++++++-- lisp/progmodes/compile.el | 4 ++++ lisp/progmodes/grep.el | 2 -- lisp/replace.el | 1 + lisp/simple.el | 10 ++++++++++ lisp/window.el | 13 +++++++++++++ 8 files changed, 50 insertions(+), 5 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 2781328cb7d..58d08b43c0e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -173,6 +173,10 @@ line; on subsequent consecutive invocations, make the current line the top line, the bottom line, and so on in cyclic order. Possibly redisplay the screen too (@code{recenter-top-bottom}). +@item C-M-S-l +Scroll the other window; this is equivalent to @kbd{C-l} acting on the +other window. + @item M-x recenter Scroll the selected window so the current line is the center-most text line. Possibly redisplay the screen too. diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index e851f1b1b58..c66deb77487 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -161,6 +161,8 @@ Select another window (@code{other-window}). Scroll the next window upward (@code{scroll-other-window}). @item C-M-S-v Scroll the next window downward (@code{scroll-other-window-down}). +@item C-M-S-l +Recenter the next window (@code{recenter-other-window}). @item mouse-1 @kbd{mouse-1}, in the text area of a window, selects the window and moves point to the position clicked. Clicking in the mode line @@ -194,6 +196,8 @@ rebind a command.) @findex scroll-other-window @kindex C-M-S-v @findex scroll-other-window-down +@kindex C-M-S-l +@findex recenter-other-window The usual scrolling commands (@pxref{Display}) apply to the selected window only, but there are also commands to scroll the next window. @kbd{C-M-v} (@code{scroll-other-window}) scrolls the window that @@ -203,7 +207,9 @@ take positive and negative arguments. (In the minibuffer, @kbd{C-M-v} scrolls the help window associated with the minibuffer, if any, rather than the next window in the standard cyclic order; @pxref{Minibuffer Edit}.) @kbd{C-M-S-v} (@code{scroll-other-window-down}) scrolls the -next window downward in a similar way. +next window downward in a similar way. Likewise, @kbd{C-M-S-l} +(@code{recenter-other-window}) behaves like @kbd{C-l} +(@code{recenter-top-bottom}) in the next window. @vindex mouse-autoselect-window If you set @code{mouse-autoselect-window} to a non-@code{nil} value, diff --git a/etc/NEWS b/etc/NEWS index 0faed3e5aa2..f65e3cf6727 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,7 +85,11 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 -** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA. ++++ +** New command 'recenter-other-window', bound to 'S-M-C-l'. +Like 'recenter-top-bottom' acting in the other window. + +** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA ** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. @@ -469,9 +473,14 @@ applied when the option 'tab-line-tab-face-functions' is so-configured. That option may also be used to customize tab-line faces in other ways. -** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and +** Occur mode + +*** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and 'previous-error-no-select' bound to 'p'. +*** The new command 'recenter-current-error', bound to 'l' in Occur or +compilation buffers, recenters the current displayed occurrence/error. + ** EIEIO +++ diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 614ed7d835d..48b5ee99736 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2069,6 +2069,10 @@ Returns the compilation buffer created." (define-key map "\M-p" 'compilation-previous-error) (define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-}" 'compilation-next-file) + (define-key map "n" 'next-error-no-select) + (define-key map "p" 'previous-error-no-select) + (define-key map "l" 'recenter-current-error) + (define-key map "g" 'recompile) ; revert ;; Set up the menu-bar (define-key map [menu-bar compilation] diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 1a8435fde33..d6ee8bb4236 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -275,8 +275,6 @@ See `compilation-error-screen-columns'." (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) (define-key map "\r" 'compile-goto-error) ;; ? - (define-key map "n" 'next-error-no-select) - (define-key map "p" 'previous-error-no-select) (define-key map "{" 'compilation-previous-file) (define-key map "}" 'compilation-next-file) (define-key map "\t" 'compilation-next-error) diff --git a/lisp/replace.el b/lisp/replace.el index d320542d629..eb7a439b54a 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1161,6 +1161,7 @@ a previously found match." (define-key map "\C-o" 'occur-mode-display-occurrence) (define-key map "n" 'next-error-no-select) (define-key map "p" 'previous-error-no-select) + (define-key map "l" 'recenter-current-error) (define-key map "\M-n" 'occur-next) (define-key map "\M-p" 'occur-prev) (define-key map "r" 'occur-rename-buffer) diff --git a/lisp/simple.el b/lisp/simple.el index 73e3fb9f847..60c13166e70 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -492,6 +492,16 @@ buffer causes automatic display of the corresponding source code location." (overlay-put ol 'window (get-buffer-window)) (setf next-error--message-highlight-overlay ol))))) +(defun recenter-current-error (&optional arg) + "Recenter the current displayed error in the `next-error' buffer." + (interactive "P") + (save-selected-window + (let ((next-error-highlight next-error-highlight-no-select) + (display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (next-error 0) + (set-buffer (window-buffer)) + (recenter-top-bottom arg)))) ;;; diff --git a/lisp/window.el b/lisp/window.el index 92ed6ee0921..2d0a73b426d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9768,6 +9768,19 @@ With plain \\[universal-argument], move current line to window center." (define-key global-map [?\C-l] 'recenter-top-bottom) +(defun recenter-other-window (&optional arg) + "Call `recenter-top-bottom' in the other window. + +A prefix argument is handled like `recenter': + With numeric prefix ARG, move current line to window-line ARG. + With plain `C-u', move current line to window center." + (interactive "P") + (with-selected-window (other-window-for-scrolling) + (recenter-top-bottom arg) + (pulse-momentary-highlight-one-line (point)))) + +(define-key global-map [?\S-\M-\C-l] 'recenter-other-window) + (defun move-to-window-line-top-bottom (&optional arg) "Position point relative to window. -- cgit v1.2.3 From 7c5938ad7d8884d03471e2395937e11611faadb9 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 17:29:57 +0100 Subject: Use `line-number-at-pos' in `count-lines' * lisp/simple.el (count-lines): Use `line-number-at-pos', which should be faster. --- lisp/simple.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 60c13166e70..568debaa612 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1453,9 +1453,9 @@ included in the count." (save-excursion (save-restriction (narrow-to-region start end) - (goto-char (point-min)) (cond ((and (not ignore-invisible-lines) (eq selective-display t)) + (goto-char (point-min)) (save-match-data (let ((done 0)) (while (re-search-forward "\n\\|\r[^\n]" nil t 40) @@ -1468,6 +1468,7 @@ included in the count." (1+ done) done)))) (ignore-invisible-lines + (goto-char (point-min)) (save-match-data (- (buffer-size) (forward-line (buffer-size)) @@ -1482,7 +1483,11 @@ included in the count." (assq prop buffer-invisibility-spec))) (setq invisible-count (1+ invisible-count)))) invisible-count)))) - (t (- (buffer-size) (forward-line (buffer-size)))))))) + (t + (goto-char (point-max)) + (if (bolp) + (1- (line-number-at-pos)) + (line-number-at-pos))))))) (defcustom what-cursor-show-names nil "Whether to show character names in `what-cursor-position'." -- cgit v1.2.3 From 5a1222196b5a9c3b8afe5c24cd16649a796fa11a Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 7 Feb 2021 19:38:49 +0100 Subject: ; Rearrange changed entry in etc/NEWS --- etc/NEWS | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index f65e3cf6727..b3d53bf73c9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,12 +85,12 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 +** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA. + +++ ** New command 'recenter-other-window', bound to 'S-M-C-l'. Like 'recenter-top-bottom' acting in the other window. -** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA - ** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. -- cgit v1.2.3 From fa735ebc0cd4fbb96ae05b494f7728f5707a8536 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 7 Feb 2021 13:46:50 -0800 Subject: Fix namazu search result parsing in gnus-search * lisp/gnus/gnus-search.el (gnus-search-indexed-extract): This method is documented to leave point at the end of the extracted search result. The namazu implementation wasn't doing that. --- lisp/gnus/gnus-search.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 0783d34733a..21602f825c1 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1514,6 +1514,7 @@ Namazu provides a little more information, for instance a score." (when (re-search-forward "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)" nil t) + (forward-line 1) (list (match-string 4) (match-string 3)))) -- cgit v1.2.3 From 651aefa31246a786891e2e743800dbf753223928 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Feb 2021 00:24:11 +0100 Subject: Add tests for count-lines * test/lisp/simple-tests.el (simple-test-count-lines) (simple-test-count-lines/ignore-invisible-lines): Add tests. --- test/lisp/simple-tests.el | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 7b022811a5c..b4007a6c3f3 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -47,6 +47,26 @@ (dotimes (_i 10) (insert (propertize "test " 'field (cons nil nil)))) (should (= (count-words (point-min) (point-max)) 10)))) + +;;; `count-lines' + +(ert-deftest simple-test-count-lines () + (with-temp-buffer + (should (= (count-lines (point-min) (point-max)) 0)) + (insert "foo") + (should (= (count-lines (point-min) (point-max)) 1)) + (insert "\nbar\nbaz\n") + (should (= (count-lines (point-min) (point-max)) 3)) + (insert "r\n") + (should (= (count-lines (point-min) (point-max)) 4)))) + +(ert-deftest simple-test-count-lines/ignore-invisible-lines () + (with-temp-buffer + (insert "foo\nbar") + (should (= (count-lines (point-min) (point-max) t) 2)) + (insert (propertize "\nbar\nbaz\nzut" 'invisible t)) + (should (= (count-lines (point-min) (point-max) t) 2)))) + ;;; `transpose-sexps' (defmacro simple-test--transpositions (&rest body) -- cgit v1.2.3 From 7d4d577ed14fb2519ea2eaecb11c8ecff658f147 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Feb 2021 00:25:16 +0100 Subject: Prefer setq-local in a few more places * lisp/calc/calc-embed.el (calc-embedded-make-info): * lisp/calc/calcalg2.el (calcFunc-integ): * lisp/comint.el (comint-mode): * lisp/epa.el (epa--list-keys, epa--show-key): * lisp/epg.el (epg--start): * lisp/vc/ediff-util.el (ediff-activate-mark): Prefer setq-local. --- lisp/calc/calc-embed.el | 30 ++++++++++-------------------- lisp/calc/calcalg2.el | 4 +--- lisp/comint.el | 3 +-- lisp/epa.el | 6 ++---- lisp/epg.el | 24 ++++++++---------------- lisp/vc/ediff-util.el | 4 ++-- 6 files changed, 24 insertions(+), 47 deletions(-) diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index cfb3fda106c..74551404776 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -854,31 +854,21 @@ The command \\[yank] can retrieve it from there." (newmode (cl-assoc-if #'derived-mode-p calc-embedded-open-close-mode-alist))) (when newann - (make-local-variable 'calc-embedded-announce-formula) - (setq calc-embedded-announce-formula (cdr newann))) + (setq-local calc-embedded-announce-formula (cdr newann))) (when newform - (make-local-variable 'calc-embedded-open-formula) - (make-local-variable 'calc-embedded-close-formula) - (setq calc-embedded-open-formula (nth 0 (cdr newform))) - (setq calc-embedded-close-formula (nth 1 (cdr newform)))) + (setq-local calc-embedded-open-formula (nth 0 (cdr newform))) + (setq-local calc-embedded-close-formula (nth 1 (cdr newform)))) (when newword - (make-local-variable 'calc-embedded-word-regexp) - (setq calc-embedded-word-regexp (nth 1 newword))) + (setq-local calc-embedded-word-regexp (nth 1 newword))) (when newplain - (make-local-variable 'calc-embedded-open-plain) - (make-local-variable 'calc-embedded-close-plain) - (setq calc-embedded-open-plain (nth 0 (cdr newplain))) - (setq calc-embedded-close-plain (nth 1 (cdr newplain)))) + (setq-local calc-embedded-open-plain (nth 0 (cdr newplain))) + (setq-local calc-embedded-close-plain (nth 1 (cdr newplain)))) (when newnewform - (make-local-variable 'calc-embedded-open-new-formula) - (make-local-variable 'calc-embedded-close-new-formula) - (setq calc-embedded-open-new-formula (nth 0 (cdr newnewform))) - (setq calc-embedded-close-new-formula (nth 1 (cdr newnewform)))) + (setq-local calc-embedded-open-new-formula (nth 0 (cdr newnewform))) + (setq-local calc-embedded-close-new-formula (nth 1 (cdr newnewform)))) (when newmode - (make-local-variable 'calc-embedded-open-mode) - (make-local-variable 'calc-embedded-close-mode) - (setq calc-embedded-open-mode (nth 0 (cdr newmode))) - (setq calc-embedded-close-mode (nth 1 (cdr newmode))))))) + (setq-local calc-embedded-open-mode (nth 0 (cdr newmode))) + (setq-local calc-embedded-close-mode (nth 1 (cdr newmode))))))) (while (and (cdr found) (> point (aref (car (cdr found)) 3))) (setq found (cdr found))) diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index fc6eb74e9f1..94b99aa29d8 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -1545,9 +1545,7 @@ (set-buffer trace-buffer) (goto-char (point-max)) (or (assq 'scroll-stop (buffer-local-variables)) - (progn - (make-local-variable 'scroll-step) - (setq scroll-step 3))) + (setq-local scroll-step 3)) (insert "\n\n\n") (set-buffer calcbuf) (math-try-integral sexpr)) diff --git a/lisp/comint.el b/lisp/comint.el index a9633d08ba1..57df6bfb19f 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -700,8 +700,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'." ;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00827.html ;; ;; This makes it really work to keep point at the bottom. - ;; (make-local-variable 'scroll-conservatively) - ;; (setq scroll-conservatively 10000) + ;; (setq-local scroll-conservatively 10000) (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t) (make-local-variable 'comint-ptyp) (make-local-variable 'comint-process-echoes) diff --git a/lisp/epa.el b/lisp/epa.el index 197cd92f977..572c947e4b2 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -379,8 +379,7 @@ DOC is documentation text to insert at the start." (goto-char point)) (epa--insert-keys (epg-list-keys context name secret))) - (make-local-variable 'epa-list-keys-arguments) - (setq epa-list-keys-arguments (list name secret)) + (setq-local epa-list-keys-arguments (list name secret)) (goto-char (point-min)) (pop-to-buffer (current-buffer))) @@ -500,8 +499,7 @@ If SECRET is non-nil, list secret keys instead of public keys." (format "*Key*%s" (epg-sub-key-id primary-sub-key))))) (set-buffer (cdr entry)) (epa-key-mode) - (make-local-variable 'epa-key) - (setq epa-key key) + (setq-local epa-key key) (erase-buffer) (setq pointer (epg-key-user-id-list key)) (while pointer diff --git a/lisp/epg.el b/lisp/epg.el index 36794d09a75..36515ef4e5f 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -641,22 +641,14 @@ callback data (if any)." (with-current-buffer buffer (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil)) - (make-local-variable 'epg-last-status) - (setq epg-last-status nil) - (make-local-variable 'epg-read-point) - (setq epg-read-point (point-min)) - (make-local-variable 'epg-process-filter-running) - (setq epg-process-filter-running nil) - (make-local-variable 'epg-pending-status-list) - (setq epg-pending-status-list nil) - (make-local-variable 'epg-key-id) - (setq epg-key-id nil) - (make-local-variable 'epg-context) - (setq epg-context context) - (make-local-variable 'epg-agent-file) - (setq epg-agent-file agent-file) - (make-local-variable 'epg-agent-mtime) - (setq epg-agent-mtime agent-mtime)) + (setq-local epg-last-status nil) + (setq-local epg-read-point (point-min)) + (setq-local epg-process-filter-running nil) + (setq-local epg-pending-status-list nil) + (setq-local epg-key-id nil) + (setq-local epg-context context) + (setq-local epg-agent-file agent-file) + (setq-local epg-agent-mtime agent-mtime)) (setq error-process (make-pipe-process :name "epg-error" :buffer (generate-new-buffer " *epg-error*") diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index f955ba8283a..9909dcd5424 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3998,8 +3998,8 @@ Mail anyway? (y or n) ") (define-obsolete-function-alias 'ediff-deactivate-mark #'deactivate-mark "27.1") (defun ediff-activate-mark () - (make-local-variable 'transient-mark-mode) - (setq mark-active 'ediff-util transient-mark-mode t)) + (setq mark-active 'ediff-util) + (setq-local transient-mark-mode t)) (define-obsolete-function-alias 'ediff-nuke-selective-display #'ignore "27.1") -- cgit v1.2.3 From efb10ffdb75ba61353b3451797e0214ac2f03171 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 07:11:52 +0100 Subject: Fix noninteractive gnus-article-press-button * lisp/gnus/gnus-art.el (gnus-article-press-button): Make the `b' summary mode command work again. --- lisp/gnus/gnus-art.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 70ededf1ba1..7ded9e40e99 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -7894,7 +7894,8 @@ If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property." (interactive (list last-nonmenu-event)) (save-excursion - (mouse-set-point event) + (when event + (mouse-set-point event)) (let ((fun (get-text-property (point) 'gnus-callback))) (when fun (funcall fun (get-text-property (point) 'gnus-data)))))) -- cgit v1.2.3 From f2814b2018f731a9b299422191591e5b1e857827 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 07:22:02 +0100 Subject: Make `C-a' in enriched-mode behave more line in other modes * lisp/textmodes/enriched.el (enriched-mode-map): Don't rebind beginning-or-line, because it makes `C-S-a' not mark the region, and it doesn't allow actually moving to the beginning of the line if the line starts with characters in `adaptive-fill-regexp' (bug#22554). --- lisp/textmodes/enriched.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index bac209cdef6..fe92d603065 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -186,7 +186,6 @@ The value is a list of \(VAR VALUE VAR VALUE...).") (defvar enriched-mode-map (let ((map (make-sparse-keymap))) - (define-key map [remap move-beginning-of-line] 'beginning-of-line-text) (define-key map "\C-m" 'reindent-then-newline-and-indent) (define-key map [remap newline-and-indent] 'reindent-then-newline-and-indent) -- cgit v1.2.3 From 33c9556c9db9b8c62dcd80dd3cc665e669ea66d4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 07:30:18 +0100 Subject: Clarify "changes" in CONTRIBUTE * CONTRIBUTE: Clarify that "changes" doesn't include removing code (bug#44834). --- CONTRIBUTE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index cb09391c324..9b2af9ccf13 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -67,7 +67,7 @@ error-prone. It also allows sending patches whose author is someone other than the email sender. Once the cumulative amount of your submissions exceeds about 15 lines -of non-trivial changes, we will need you to assign to the FSF the +of non-trivial code, we will need you to assign to the FSF the copyright for your contributions. Ask on emacs-devel@gnu.org, and we will send you the necessary form together with the instructions to fill and email it, in order to start this legal paperwork. -- cgit v1.2.3 From 798bd1273c5ba85427952e6eee22c8eeda58e85e Mon Sep 17 00:00:00 2001 From: Anticrisis Date: Mon, 8 Feb 2021 07:33:49 +0100 Subject: Fix tcl-mode indentation of namespaced code * lisp/progmodes/tcl.el (tcl-calculate-indent): Fix indentation when using namespaces (bug#44834). (tcl-beginning-of-defun-function): Remove. This partially reverts cd5bb4bf3dbad8941d25823f398b595b8f0edbb9. Copyright-paperwork-exempt: yes --- lisp/progmodes/tcl.el | 29 +++++------------------------ test/lisp/progmodes/tcl-tests.el | 1 - 2 files changed, 5 insertions(+), 25 deletions(-) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 0a0118a5eba..82e1343e057 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -651,7 +651,6 @@ already exist." (setq-local add-log-current-defun-function #'tcl-add-log-defun) - (setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function) (setq-local end-of-defun-function #'tcl-end-of-defun-function)) @@ -849,14 +848,12 @@ Returns nil if line starts inside a string, t if in a comment." state containing-sexp found-next-line) - (cond - (parse-start + + (if parse-start (goto-char parse-start)) - ((not (beginning-of-defun)) - ;; If we're not in a function, don't use - ;; `tcl-beginning-of-defun-function'. - (let ((beginning-of-defun-function nil)) - (beginning-of-defun)))) + + (beginning-of-defun) + (while (< (point) indent-point) (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) @@ -1035,22 +1032,6 @@ Returns nil if line starts inside a string, t if in a comment." ;; Interfaces to other packages. ;; -(defun tcl-beginning-of-defun-function (&optional arg) - "`beginning-of-defun-function' for Tcl mode." - (when (or (not arg) (= arg 0)) - (setq arg 1)) - (let* ((search-fn (if (> arg 0) - ;; Positive arg means to search backward. - #'re-search-backward - #'re-search-forward)) - (arg (abs arg)) - (result t)) - (while (and (> arg 0) result) - (unless (funcall search-fn tcl-proc-regexp nil t) - (setq result nil)) - (setq arg (1- arg))) - result)) - (defun tcl-end-of-defun-function () "`end-of-defun-function' for Tcl mode." ;; Because we let users redefine tcl-proc-list, we don't really know diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el index cf1ed2896e4..e55eb6d901b 100644 --- a/test/lisp/progmodes/tcl-tests.el +++ b/test/lisp/progmodes/tcl-tests.el @@ -74,7 +74,6 @@ ;; From bug#44834 (ert-deftest tcl-mode-namespace-indent-2 () - :expected-result :failed (with-temp-buffer (tcl-mode) (let ((text "namespace eval Foo {\n proc foo {} {}\n\n proc bar {}{}}\n")) -- cgit v1.2.3 From 657641fb83b927a8da18bccfcf843b0a3b720755 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 8 Feb 2021 07:52:16 +0100 Subject: Bind clone-buffer to C-x x n * lisp/bindings.el (ctl-x-x-map): Bind clone-buffer. * etc/NEWS: Document the change (bug#46369). --- etc/NEWS | 5 +++-- lisp/bindings.el | 1 + 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b3d53bf73c9..05a8beb7402 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -241,8 +241,9 @@ search buffer due to too many matches being highlighted. ** A new keymap for buffer actions has been added. The 'C-x x' keymap now holds keystrokes for various buffer-oriented commands. The new keystrokes are 'C-x x g' ('revert-buffer'), -'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), -'C-x x i' ('insert-buffer') and 'C-x x t' ('toggle-truncate-lines'). +'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n' +('clone-buffer'), 'C-x x i' ('insert-buffer') and 'C-x x t' +('toggle-truncate-lines'). * Editing Changes in Emacs 28.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index 9462468b1b0..2f4bab11cf5 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1418,6 +1418,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key map "g" #'revert-buffer) (define-key map "r" #'rename-buffer) (define-key map "u" #'rename-uniquely) + (define-key map "n" #'clone-buffer) (define-key map "i" #'insert-buffer) (define-key map "t" #'toggle-truncate-lines) map) -- cgit v1.2.3 From 9fdc753e1450d1b2eb610ef4fc55460d63688799 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Mon, 8 Feb 2021 07:54:54 +0100 Subject: Add vc-dir faces; also apply them to vc-git * etc/NEWS: Document the new faces. * lisp/vc/vc-dir.el (vc-dir-header, vc-dir-header-value) (vc-dir-directory, vc-dir-file, vc-dir-mark-indicator) (vc-dir-status-warning, vc-dir-status-edited, vc-dir-status-up-to-date) (vc-dir-ignored): Add new faces. * lisp/vc/vc-git.el (vc-git-permissions-as-string, vc-git-dir-printer) (vc-git-dir-extra-headers): Apply new faces (bug#46358). --- etc/NEWS | 6 ++++++ lisp/vc/vc-dir.el | 58 ++++++++++++++++++++++++++++++++++++++++++++----------- lisp/vc/vc-git.el | 37 +++++++++++++++++------------------ 3 files changed, 71 insertions(+), 30 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 05a8beb7402..40fe2156006 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -601,6 +601,12 @@ their 'default-directory' under VC. This is used when expanding commit messages from 'vc-print-root-log' and similar commands. +--- +*** New faces for 'vc-dir' buffers and their Git VC backend. +Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory', +'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning', +'vc-dir-status-edited', 'vc-dir-status-up-to-date', 'vc-dir-ignored'. + --- *** The responsible VC backend is now the most specific one. 'vc-responsible-backend' loops over the backends in diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9d0808c0435..14c81578b79 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -54,6 +54,42 @@ See `run-hooks'." :type 'hook :group 'vc) +(defface vc-dir-header '((t :inherit font-lock-type-face)) + "Face for headers in VC-dir buffers." + :group 'vc) + +(defface vc-dir-header-value '((t :inherit font-lock-variable-name-face)) + "Face for header values in VC-dir buffers." + :group 'vc) + +(defface vc-dir-directory '((t :inherit font-lock-comment-delimiter-face)) + "Face for directories in VC-dir buffers." + :group 'vc) + +(defface vc-dir-file '((t :inherit font-lock-function-name-face)) + "Face for files in VC-dir buffers." + :group 'vc) + +(defface vc-dir-mark-indicator '((t :inherit font-lock-type-face)) + "Face for mark indicators in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-warning '((t :inherit font-lock-warning-face)) + "Face for warning status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-edited '((t :inherit font-lock-variable-name-face)) + "Face for edited status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-up-to-date '((t :inherit font-lock-builtin-face)) + "Face for up-to-date status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-ignored '((t :inherit shadow)) + "Face for ignored or empty values in VC-dir buffers." + :group 'vc) + ;; Used to store information for the files displayed in the directory buffer. ;; Each item displayed corresponds to one of these defstructs. (cl-defstruct (vc-dir-fileinfo @@ -1126,11 +1162,11 @@ It calls the `dir-extra-headers' backend method to display backend specific headers." (concat ;; First layout the common headers. - (propertize "VC backend : " 'face 'font-lock-type-face) - (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face) - (propertize "Working dir: " 'face 'font-lock-type-face) + (propertize "VC backend : " 'face 'vc-dir-header) + (propertize (format "%s\n" backend) 'face 'vc-dir-header-value) + (propertize "Working dir: " 'face 'vc-dir-header) (propertize (format "%s\n" (abbreviate-file-name dir)) - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) ;; Then the backend specific ones. (vc-call-backend backend 'dir-extra-headers dir) "\n")) @@ -1386,9 +1422,9 @@ These are the commands available for use in the file status buffer: ;; backend specific headers. ;; XXX: change this to return nil before the release. (concat - (propertize "Extra : " 'face 'font-lock-type-face) + (propertize "Extra : " 'face 'vc-dir-header) (propertize "Please add backend specific headers here. It's easy!" - 'face 'font-lock-warning-face))) + 'face 'vc-dir-status-warning))) (defvar vc-dir-status-mouse-map (let ((map (make-sparse-keymap))) @@ -1414,21 +1450,21 @@ These are the commands available for use in the file status buffer: (insert (propertize (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? )) - 'face 'font-lock-type-face) + 'face 'vc-dir-mark-indicator) " " (propertize (format "%-20s" state) - 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) - ((memq state '(missing conflict)) 'font-lock-warning-face) + 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) + ((memq state '(missing conflict)) 'vc-dir-status-warning) ((eq state 'edited) 'font-lock-constant-face) - (t 'font-lock-variable-name-face)) + (t 'vc-dir-header-value)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) " " (propertize (format "%s" filename) 'face - (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face) + (if isdir 'vc-dir-directory 'vc-dir-file) 'help-echo (if isdir "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu" diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index d00c2c2133c..e7306386fea 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -462,7 +462,7 @@ or an empty string if none." (eq 0 (logand ?\111 (logxor old-perm new-perm)))) " " (if (eq 0 (logand ?\111 old-perm)) "+x" "-x")) - 'face 'font-lock-type-face)) + 'face 'vc-dir-header)) (defun vc-git-dir-printer (info) "Pretty-printer for the vc-dir-fileinfo structure." @@ -474,20 +474,20 @@ or an empty string if none." (insert " " (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? )) - 'face 'font-lock-type-face) + 'face 'vc-dir-mark-indicator) " " (propertize (format "%-12s" state) - 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) - ((eq state '(missing conflict)) 'font-lock-warning-face) - (t 'font-lock-variable-name-face)) + 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) + ((eq state '(missing conflict)) 'vc-dir-status-warning) + (t 'vc-dir-status-edited)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) " " (vc-git-permissions-as-string old-perm new-perm) " " (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info)) - 'face (if isdir 'font-lock-comment-delimiter-face - 'font-lock-function-name-face) + 'face (if isdir 'vc-dir-directory + 'vc-dir-file) 'help-echo (if isdir "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu" @@ -784,7 +784,7 @@ or an empty string if none." (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'vc-git-hideable all-hideable 'help-echo vc-git-stash-list-help @@ -800,7 +800,7 @@ or an empty string if none." (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'invisible t 'vc-git-hideable t @@ -810,33 +810,32 @@ or an empty string if none." (propertize "\n" 'invisible t 'vc-git-hideable t)))))))) - ;; FIXME: maybe use a different face when nothing is stashed. (concat - (propertize "Branch : " 'face 'font-lock-type-face) + (propertize "Branch : " 'face 'vc-dir-header) (propertize branch - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) (when remote-url (concat "\n" - (propertize "Remote : " 'face 'font-lock-type-face) + (propertize "Remote : " 'face 'vc-dir-header) (propertize remote-url - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) ;; For now just a heading, key bindings can be added later for various bisect actions (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir))) - (propertize "\nBisect : in progress" 'face 'font-lock-warning-face)) + (propertize "\nBisect : in progress" 'face 'vc-dir-status-warning)) (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir))) - (propertize "\nRebase : in progress" 'face 'font-lock-warning-face)) + (propertize "\nRebase : in progress" 'face 'vc-dir-status-warning)) (if stash-list (concat - (propertize "\nStash : " 'face 'font-lock-type-face) + (propertize "\nStash : " 'face 'vc-dir-header) stash-button stash-string) (concat - (propertize "\nStash : " 'face 'font-lock-type-face) + (propertize "\nStash : " 'face 'vc-dir-header) (propertize "Nothing stashed" 'help-echo vc-git-stash-shared-help 'keymap vc-git-stash-shared-map - 'face 'font-lock-variable-name-face)))))) + 'face 'vc-dir-ignored)))))) (defun vc-git-branches () "Return the existing branches, as a list of strings. -- cgit v1.2.3 From 4428c27c1ae7d5fe5233e8d7b001a8cd2fcdc56f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 08:15:45 +0100 Subject: Record the value of `C-x C-e' in `values' * lisp/progmodes/elisp-mode.el (eval-last-sexp): Record the value in `values' (bug#22066) since we're messaging it. --- lisp/progmodes/elisp-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 9348a7f0d2f..a0968663163 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1268,7 +1268,9 @@ If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") (if (null eval-expression-debug-on-error) - (elisp--eval-last-sexp eval-last-sexp-arg-internal) + (let ((value (elisp--eval-last-sexp eval-last-sexp-arg-internal))) + (push value values) + value) (let ((value (let ((debug-on-error elisp--eval-last-sexp-fake-value)) (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) -- cgit v1.2.3