commit b373c8ad71eb3877294451af5eb75819c706785a (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue Jan 25 14:42:33 2022 +0800 Fix tool bar size reporting on GTK when the display is scaled * src/gtkutil.c (xg_update_tool_bar_sizes): Multiply sizes to turn them into device pixels. diff --git a/src/gtkutil.c b/src/gtkutil.c index eb14856062..607cf5ee2e 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -5471,6 +5471,7 @@ xg_update_tool_bar_sizes (struct frame *f) GtkRequisition req; int nl = 0, nr = 0, nt = 0, nb = 0; GtkWidget *top_widget = x->toolbar_widget; + int scale = xg_get_scale (f); gtk_widget_get_preferred_size (GTK_WIDGET (top_widget), NULL, &req); if (x->toolbar_in_hbox) @@ -5479,8 +5480,10 @@ xg_update_tool_bar_sizes (struct frame *f) gtk_container_child_get (GTK_CONTAINER (x->hbox_widget), top_widget, "position", &pos, NULL); - if (pos == 0) nl = req.width; - else nr = req.width; + if (pos == 0) + nl = req.width * scale; + else + nr = req.width * scale; } else { @@ -5488,8 +5491,10 @@ xg_update_tool_bar_sizes (struct frame *f) gtk_container_child_get (GTK_CONTAINER (x->vbox_widget), top_widget, "position", &pos, NULL); - if (pos == 0 || (pos == 1 && x->menubar_widget)) nt = req.height; - else nb = req.height; + if (pos == 0 || (pos == 1 && x->menubar_widget)) + nt = req.height * scale; + else + nb = req.height * scale; } if (nl != FRAME_TOOLBAR_LEFT_WIDTH (f) commit ff63787ea18a27e991052ca04d0de0526ad5ec59 Merge: ec403abc60 c34d06e3d7 Author: Stefan Kangas Date: Tue Jan 25 06:31:03 2022 +0100 Merge from origin/emacs-28 c34d06e3d7 * configure.ac (LIBSECCOMP): Bump minimum version for facc... 335a5a9e0f Make the `f' command work in image-mode again commit ec403abc6078e2236762d85fe206703602014377 Author: Po Lu Date: Tue Jan 25 11:49:39 2022 +0800 Improve portability of X11 IM code * configure.ac: Test for XICCallback.callback if X11R6 or later. * src/xfns.c (Xxic_preedit_start_callback): Use XICCallback if present. diff --git a/configure.ac b/configure.ac index e5574b6b05..ae92b85be1 100644 --- a/configure.ac +++ b/configure.ac @@ -2639,6 +2639,7 @@ fail; AC_DEFINE(HAVE_X11R6, 1, [Define to 1 if you have the X11R6 or newer version of Xlib.]) AC_DEFINE(HAVE_X_I18N, 1, [Define if you have usable i18n support.]) + AC_CHECK_MEMBERS([XICCallback.callback], [], [], [#include ]) ## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style ## XIM support. case "$opsys" in diff --git a/src/xfns.c b/src/xfns.c index bb1e431ff8..faab1b1158 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2342,14 +2342,19 @@ static void xic_preedit_caret_callback (XIC, XPointer, XIMPreeditCaretCallbackSt static void xic_preedit_done_callback (XIC, XPointer, XPointer); static int xic_preedit_start_callback (XIC, XPointer, XPointer); +#ifndef HAVE_XICCALLBACK_CALLBACK +#define XICCallback XIMCallback +#define XICProc XIMProc +#endif + static XIMCallback Xxic_preedit_draw_callback = { NULL, (XIMProc) xic_preedit_draw_callback }; static XIMCallback Xxic_preedit_caret_callback = { NULL, (XIMProc) xic_preedit_caret_callback }; static XIMCallback Xxic_preedit_done_callback = { NULL, (XIMProc) xic_preedit_done_callback }; -static XIMCallback Xxic_preedit_start_callback = { NULL, - (void *) xic_preedit_start_callback }; +static XICCallback Xxic_preedit_start_callback = { NULL, + (XICProc) xic_preedit_start_callback }; #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT /* Create an X fontset on frame F with base font name BASE_FONTNAME. */ commit 96929e5d012583e1bcba3998076136701caf3165 Author: Stefan Monnier Date: Mon Jan 24 21:31:53 2022 -0500 Remove some dubious uses of `interactive-form` * lisp/emacs-lisp/cl-generic.el (cl--generic-lambda): `commandp` and `interactive-form` are for function values, not for source code. * lisp/cedet/semantic/db-el.el (semanticdb-elisp-sym->tag): Prefer `commandp` over `interactive-form`. diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 73ef37ea2a..02ebde4078 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -213,9 +213,7 @@ TOKTYPE is a hint to the type of tag desired." (symbol-name sym) nil ;; return type (semantic-elisp-desymbolify arglist) - :user-visible-flag (condition-case nil - (interactive-form sym) - (error nil))))) + :user-visible-flag (commandp sym)))) ((and (eq toktype 'variable) (boundp sym)) (semantic-tag-new-variable (symbol-name sym) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 53691881ec..5e0e0834ff 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -381,9 +381,9 @@ the specializer used will be the one returned by BODY." . ,(lambda () spec-args)) macroexpand-all-environment))) (require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'. - (when (interactive-form (cadr fun)) - (message "Interactive forms unsupported in generic functions: %S" - (interactive-form (cadr fun)))) + (when (assq 'interactive (cadr fun)) + (message "Interactive forms not supported in generic functions: %S" + (assq 'interactive (cadr fun)))) ;; First macroexpand away the cl-function stuff (e.g. &key and ;; destructuring args, `declare' and whatnot). (pcase (macroexpand fun macroenv) commit ea953db0a06f1ca3e66fb2de6ec7500011d9b161 Author: Po Lu Date: Tue Jan 25 10:14:28 2022 +0800 Fix invalid picture after toggling the tool bar or menu bar on GTK * src/xterm.c (x_drop_xrender_surfaces): New function. (handle_one_xevent): Call x_drop_xrender_surfaces instead of just font_drop_xrender_surfaces. diff --git a/src/xterm.c b/src/xterm.c index bf611db6bc..919c8b12ab 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -358,6 +358,22 @@ x_flush (struct frame *f) unblock_input (); } +static void +x_drop_xrender_surfaces (struct frame *f) +{ + font_drop_xrender_surfaces (f); + +#ifdef HAVE_XRENDER + if (f && FRAME_X_DOUBLE_BUFFERED_P (f) + && FRAME_X_PICTURE (f) != None) + { + XRenderFreePicture (FRAME_X_DISPLAY (f), + FRAME_X_PICTURE (f)); + FRAME_X_PICTURE (f) = None; + } +#endif +} + #ifdef HAVE_XRENDER MAYBE_UNUSED static void x_xr_ensure_picture (struct frame *f) @@ -9061,7 +9077,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } if (FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); f->output_data.x->has_been_visible = true; SET_FRAME_GARBAGED (f); unblock_input (); @@ -9885,23 +9901,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, } f = x_top_window_to_frame (dpyinfo, configureEvent.xconfigure.window); - /* Unfortunately, we need to call font_drop_xrender_surfaces for + /* Unfortunately, we need to call x_drop_xrender_surfaces for _all_ ConfigureNotify events, otherwise we miss some and flicker. Don't try to optimize these calls by looking only for size changes: that's not sufficient. We miss some surface invalidations and flicker. */ block_input (); if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); -#ifdef HAVE_XRENDER - if (f && FRAME_X_DOUBLE_BUFFERED_P (f) - && FRAME_X_PICTURE (f) != None) - { - XRenderFreePicture (FRAME_X_DISPLAY (f), - FRAME_X_PICTURE (f)); - FRAME_X_PICTURE (f) = None; - } -#endif + x_drop_xrender_surfaces (f); unblock_input (); #if defined USE_CAIRO && !defined USE_GTK if (f) @@ -9931,7 +9938,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); unblock_input (); xg_frame_resized (f, configureEvent.xconfigure.width, configureEvent.xconfigure.height); commit eb4edfa0c86c27d0f978bc2551ba4ebee9dda63f Author: Po Lu Date: Tue Jan 25 08:21:55 2022 +0800 Fix GTK native input on scaled displays * src/xfns.c (xic_set_preeditarea): Scale preedit spot rectangle before giving it to GTK. diff --git a/src/xfns.c b/src/xfns.c index 33d8d98e70..bb1e431ff8 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2844,14 +2844,16 @@ xic_set_preeditarea (struct window *w, int x, int y) } #ifdef USE_GTK GdkRectangle rect; + int scale = xg_get_scale (f); + rect.x = (WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w) - + WINDOW_LEFT_MARGIN_WIDTH (w)); + + WINDOW_LEFT_MARGIN_WIDTH (w)) / scale; rect.y = (WINDOW_TO_FRAME_PIXEL_Y (w, y) + FRAME_TOOLBAR_HEIGHT (f) - + FRAME_MENUBAR_HEIGHT (f)); - rect.width = w->phys_cursor_width; - rect.height = w->phys_cursor_height; + + FRAME_MENUBAR_HEIGHT (f)) / scale; + rect.width = w->phys_cursor_width / scale; + rect.height = w->phys_cursor_height / scale; gtk_im_context_set_cursor_location (FRAME_X_OUTPUT (f)->im_context, &rect); commit 667e212048a1443b6f72647176aec701d18474c9 Author: Sean Whitton Date: Mon Jan 17 15:15:36 2022 -0700 Add Eshell syntax to more easily bypass Eshell's own pipelining * etc/NEWS: * doc/misc/eshell.texi (Input/Output): Document the new syntax. * lisp/eshell/em-extpipe.el: New module (Bug#46351). * test/lisp/eshell/em-extpipe-tests.el: New tests. * lisp/eshell/esh-module.el (eshell-modules-list): Add `eshell-extpipe'. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index df6e3b861e..261e88d00c 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1142,6 +1142,48 @@ the output function. The output function is called once on each line of output until @code{nil} is passed, indicating end of output. +@section Running Shell Pipelines Natively +When constructing shell pipelines that will move a lot of data, it is +a good idea to bypass Eshell's own pipelining support and use the +operating system shell's instead. This is especially relevant when +executing commands on a remote machine using Eshell's Tramp +integration: using the remote shell's pipelining avoids copying the +data which will flow through the pipeline to local Emacs buffers and +then right back again. + +Eshell recognises a special syntax to make it easier to convert +pipelines so as to bypass Eshell's pipelining. Prefixing at least one +@code{|}, @code{<} or @code{>} with an asterisk marks a command as +intended for the operating system shell. To make it harder to invoke +this functionality accidentally, it is also required that the asterisk +be preceded by whitespace or located at the start of input. For +example, + +@example + cat *.ogg *| my-cool-decoder >file +@end example + +Executing this command will not copy all the data in the *.ogg files, +nor the decoded data, into Emacs buffers, as would normally happen. + +The command is interpreted as extending up to the next @code{|} +character which is not preceded by an unescaped asterisk following +whitespace, or the end of the input if there is no such character. +Thus, all @code{<} and @code{>} redirections occuring before the next +asterisk-unprefixed @code{|} are implicitly prefixed with (whitespace +and) asterisks. An exception is that Eshell-specific redirects right +at the end of the command are excluded. This allows input like this: + +@example + foo *| baz ># +@end example + +@noindent which is equivalent to input like this: + +@example + sh -c "foo | baz" ># +@end example + @node Extension modules @chapter Extension modules Eshell provides a facility for defining extension modules so that they diff --git a/etc/NEWS b/etc/NEWS index 46a734e854..abef1019ac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -875,6 +875,16 @@ the Galeon web browser was released in September, 2008. *** New user option 'ruby-toggle-block-space-before-parameters'. +** Eshell + ++++ +*** New feature to easily bypass Eshell's own pipelining. +Prefixing '|', '<' or '>' with an asterisk, i.e. '*|', '*<' or '*>', +will cause the whole command to be passed to the operating system +shell. This is particularly useful to bypass Eshell's own pipelining +support for pipelines which will move a lot of data. See "Running +Shell Pipelines Natively" in the Eshell manual. + ** Miscellaneous --- diff --git a/lisp/eshell/em-extpipe.el b/lisp/eshell/em-extpipe.el new file mode 100644 index 0000000000..57aeec38ff --- /dev/null +++ b/lisp/eshell/em-extpipe.el @@ -0,0 +1,183 @@ +;;; em-extpipe.el --- external shell pipelines -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Sean Whitton + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; When constructing shell pipelines that will move a lot of data, it +;; is a good idea to bypass Eshell's own pipelining support and use +;; the operating system shell's instead. This module tries to make +;; that easy to do. + +;;; Code: + +(require 'cl-lib) +(require 'esh-arg) +(require 'esh-io) +(require 'esh-util) + +(eval-when-compile (require 'files-x)) + +;;; Functions: + +(defun eshell-extpipe-initialize () ;Called from `eshell-mode' via intern-soft! + "Initialize external pipelines support." + (when (boundp 'eshell-special-chars-outside-quoting) + (setq-local + eshell-special-chars-outside-quoting + (append eshell-special-chars-outside-quoting (list ?\*)))) + (add-hook 'eshell-parse-argument-hook + #'eshell-parse-external-pipeline -20 t) + (add-hook 'eshell-pre-rewrite-command-hook + #'eshell-rewrite-external-pipeline -20 t)) + +(defun eshell-parse-external-pipeline () + "Parse a pipeline intended for execution by the external shell. + +A sequence of arguments is rewritten to use the operating system +shell when it contains `*|', `*<' or `*>', where the asterisk is +preceded by whitespace or located at the start of input. + +The command extends to the next `|' character which is not +preceded by an unescaped asterisk following whitespace, or the +end of input, except that any Eshell-specific output redirections +occurring at the end are excluded. Any other `<' or `>' +appearing before the end of the command are treated as though +preceded by (whitespace and) an asterisk. + +For example, + + foo # + +is equivalent to + + sh -c \"foo # + +when `shell-file-name' is `sh' and `shell-command-switch' is +`-c', but in + + foo ># *| baz + +and + + foo *| baz ># --some-argument + +the Eshell-specific redirect will be passed on to the operating +system shell, probably leading to undesired results. + +This function must appear early in `eshell-parse-argument-hook' +to ensure that operating system shell syntax is not interpreted +as though it were Eshell syntax." + ;; Our goal is to wrap the external command to protect it from the + ;; other members of `eshell-parse-argument-hook'. We must avoid + ;; misinterpreting a quoted `*|', `*<' or `*>' as indicating an + ;; external pipeline, hence the structure of the loop in `findbeg1'. + (cl-flet + ((findbeg1 (pat &optional go (bound (point-max))) + (let* ((start (point)) + (result + (catch 'found + (while (> bound (point)) + (let* ((found + (save-excursion + (re-search-forward "['\"\\]" bound t))) + (next (or (and found (match-beginning 0)) + bound))) + (if (re-search-forward pat next t) + (throw 'found (match-beginning 1)) + (goto-char next) + (while (or (eshell-parse-backslash) + (eshell-parse-double-quote) + (eshell-parse-literal-quote))))))))) + (goto-char (if (and result go) (match-end 0) start)) + result))) + (unless (or eshell-current-argument eshell-current-quoted) + (let ((beg (point)) end + (next-marked (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)")) + (next-unmarked + (or (findbeg1 "\\(?:\\=\\|[^*]\\|\\S-\\*\\)\\(|\\)") + (point-max)))) + (when (and next-marked (> next-unmarked next-marked) + (or (> next-marked (point)) + (looking-back "\\`\\|\\s-" nil))) + ;; Skip to the final segment of the external pipeline. + (while (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*|\\)" t)) + ;; Find output redirections. + (while (findbeg1 + "\\([0-9]?>+&?[0-9]?\\s-*\\S-\\)" t next-unmarked) + ;; Is the output redirection Eshell-specific? We have our + ;; own logic, rather than calling `eshell-parse-argument', + ;; to avoid specifying here all the possible cars of + ;; parsed special references -- `get-buffer-create' etc. + (forward-char -1) + (let ((this-end + (save-match-data + (cond ((looking-at "#<") + (forward-char 1) + (1+ (eshell-find-delimiter ?\< ?\>))) + ((and (looking-at "/\\S-+") + (assoc (match-string 0) + eshell-virtual-targets)) + (match-end 0)))))) + (cond ((and this-end end) + (goto-char this-end)) + (this-end + (goto-char this-end) + (setq end (match-beginning 0))) + (t + (setq end nil))))) + ;; We've moved past all Eshell-specific output redirections + ;; we could find. If there is only whitespace left, then + ;; `end' is right before redirections we should exclude; + ;; otherwise, we must include everything. + (unless (and end (skip-syntax-forward "\s" next-unmarked) + (= next-unmarked (point))) + (setq end next-unmarked)) + (let ((cmd (string-trim + (buffer-substring-no-properties beg end)))) + (goto-char end) + ;; We must now drop the asterisks, unless quoted/escaped. + (with-temp-buffer + (insert cmd) + (goto-char (point-min)) + (cl-loop + for next = (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)" t) + while next do (forward-char -2) (delete-char 1)) + (eshell-finish-arg + `(eshell-external-pipeline ,(buffer-string)))))))))) + +(defun eshell-rewrite-external-pipeline (terms) + "Rewrite an external pipeline in TERMS as parsed by +`eshell-parse-external-pipeline', which see." + (while terms + (when (and (listp (car terms)) + (eq (caar terms) 'eshell-external-pipeline)) + (with-connection-local-variables + (setcdr terms (cl-list* + shell-command-switch (cadar terms) (cdr terms))) + (setcar terms shell-file-name))) + (setq terms (cdr terms)))) + +(defsubst eshell-external-pipeline (&rest _args) + "Stub to generate an error if a pipeline is not rewritten." + (error "Unhandled external pipeline in input text")) + +(provide 'em-extpipe) +;;; esh-extpipe.el ends here diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el index ade151d7cd..14e91912d1 100644 --- a/lisp/eshell/esh-module.el +++ b/lisp/eshell/esh-module.el @@ -54,6 +54,7 @@ customizing the variable `eshell-modules-list'." eshell-basic eshell-cmpl eshell-dirs + eshell-extpipe eshell-glob eshell-hist eshell-ls diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el new file mode 100644 index 0000000000..1283b6b361 --- /dev/null +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -0,0 +1,205 @@ +;;; em-extpipe-tests.el --- em-extpipe test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Sean Whitton + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + + +;;; Code: + +(require 'cl-lib) +(require 'ert) +(require 'ert-x) +(require 'em-extpipe) +(eval-and-compile + (load (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory))))) + +(defvar eshell-history-file-name) +(defvar eshell-test--max-subprocess-time) +(declare-function eshell-command-result-p "eshell-tests-helpers") + +(defmacro em-extpipe-tests--deftest (name input &rest body) + (declare (indent 2)) + `(ert-deftest ,name () + (cl-macrolet + ((should-parse (expected) + `(let ((shell-file-name "sh") + (shell-command-switch "-c")) + ;; Strip `eshell-trap-errors'. + (should (equal ,expected + (cadr (eshell-parse-command input)))))) + (with-substitute-for-temp (&rest body) + ;; Substitute name of an actual temporary file and/or + ;; buffer into `input'. The substitution logic is + ;; appropriate for only the use we put it to in this file. + `(ert-with-temp-file temp + (let ((temp-buffer (generate-new-buffer " *temp*" t))) + (unwind-protect + (let ((input + (replace-regexp-in-string + "temp\\([^>]\\|\\'\\)" temp + (string-replace "#" + (buffer-name temp-buffer) + input)))) + ,@body) + (when (buffer-name temp-buffer) + (kill-buffer temp-buffer)))))) + (temp-should-string= (expected) + `(string= ,expected (string-trim-right + (with-temp-buffer + (insert-file-contents temp) + (buffer-string))))) + (temp-buffer-should-string= (expected) + `(string= ,expected (string-trim-right + (with-current-buffer temp-buffer + (buffer-string)))))) + (skip-unless shell-file-name) + (skip-unless shell-command-switch) + (skip-unless (executable-find shell-file-name)) + (let ((input ,input)) + (with-temp-eshell ,@body))))) + +(em-extpipe-tests--deftest em-extpipe-test-1 + "echo \"bar\" *| rev >temp" + (skip-unless (executable-find "rev")) + (should-parse '(eshell-named-command + "sh" (list "-c" "echo \"bar\" | rev >temp"))) + (with-substitute-for-temp + (eshell-command-result-p input "^$") + (temp-should-string= "rab"))) + +(em-extpipe-tests--deftest em-extpipe-test-2 + "echo \"bar\" | rev *>temp" + (skip-unless (executable-find "rev")) + (should-parse + '(eshell-execute-pipeline + '((eshell-named-command "echo" (list (eshell-escape-arg "bar"))) + (eshell-named-command "sh" (list "-c" "rev >temp"))))) + (with-substitute-for-temp + (eshell-command-result-p input "^$") + (temp-should-string= "rab"))) + +(em-extpipe-tests--deftest em-extpipe-test-3 "foo *| bar | baz -d" + (should-parse + '(eshell-execute-pipeline + '((eshell-named-command "sh" (list "-c" "foo | bar")) + (eshell-named-command "baz" (list "-d")))))) + +(em-extpipe-tests--deftest em-extpipe-test-4 + "echo \"bar\" *| rev >#" + (skip-unless (executable-find "rev")) + (should-parse + '(progn + (ignore + (eshell-set-output-handle 1 'overwrite + (get-buffer-create "temp"))) + (eshell-named-command "sh" + (list "-c" "echo \"bar\" | rev")))) + (with-substitute-for-temp + (eshell-command-result-p input "^$") + (temp-buffer-should-string= "rab"))) + +(em-extpipe-tests--deftest em-extpipe-test-5 + "foo *| bar ># baz" + (should-parse '(eshell-named-command + "sh" (list "-c" "foo | bar ># baz")))) + +(em-extpipe-tests--deftest em-extpipe-test-6 + "foo ># *| bar baz" + (should-parse '(eshell-named-command + "sh" (list "-c" "foo ># | bar baz")))) + +(em-extpipe-tests--deftest em-extpipe-test-7 + "foo *| bar ># >>#" + (should-parse + '(progn + (ignore + (eshell-set-output-handle 1 'overwrite + (get-buffer-create "quux"))) + (ignore + (eshell-set-output-handle 1 'append + (get-process "other"))) + (eshell-named-command "sh" + (list "-c" "foo | bar"))))) + +(em-extpipe-tests--deftest em-extpipe-test-8 + "foo *| bar >/dev/kill | baz" + (should-parse + '(eshell-execute-pipeline + '((progn + (ignore + (eshell-set-output-handle 1 'overwrite "/dev/kill")) + (eshell-named-command "sh" + (list "-c" "foo | bar"))) + (eshell-named-command "baz"))))) + +(em-extpipe-tests--deftest em-extpipe-test-9 "foo \\*| bar" + (should-parse + '(eshell-execute-pipeline + '((eshell-named-command "foo" + (list (eshell-escape-arg "*"))) + (eshell-named-command "bar"))))) + +(em-extpipe-tests--deftest em-extpipe-test-10 "foo \"*|\" *>bar" + (should-parse + '(eshell-named-command "sh" (list "-c" "foo \"*|\" >bar")))) + +(em-extpipe-tests--deftest em-extpipe-test-11 "foo '*|' bar" + (should-parse '(eshell-named-command + "foo" (list (eshell-escape-arg "*|") "bar")))) + +(em-extpipe-tests--deftest em-extpipe-test-12 ">foo bar *| baz" + (should-parse + '(eshell-named-command "sh" (list "-c" ">foo bar | baz")))) + +(em-extpipe-tests--deftest em-extpipe-test-13 "foo*|bar" + (should-parse '(eshell-execute-pipeline + '((eshell-named-command (concat "foo" "*")) + (eshell-named-command "bar"))))) + +(em-extpipe-tests--deftest em-extpipe-test-14 "tac * Date: Sat Jan 22 18:54:55 2022 -0700 Rework eshell-match-result for testing asynchronous commands When using eshell-match-result via eshell-command-result-p to examine the output of asynchronous Eshell commands, a newly emitted prompt is included in the text against which the regexp is matched. This makes it awkward to match against the whole output; for example, to check whether it is empty. Rework the function to exclude the prompt. * test/lisp/eshell/eshell-tests-helpers.el (eshell-match-result): Exclude any newly emitted prompt from the text against which the regexp is matched. Additionally, the function no longer moves point. * test/lisp/eshell/eshell-tests.el (eshell-test/flush-output): Update and simplify test given how eshell-match-result no longer moves point. diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index 2afa63ae51..a150adb144 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -66,10 +66,11 @@ raise an error." (funcall (or func 'eshell-send-input))) (defun eshell-match-result (regexp) - "Check that text after `eshell-last-input-end' matches REGEXP." - (goto-char eshell-last-input-end) - (should (string-match-p regexp (buffer-substring-no-properties - (point) (point-max))))) + "Check that output of last command matches REGEXP." + (should + (string-match-p + regexp (buffer-substring-no-properties + (eshell-beginning-of-output) (eshell-end-of-output))))) (defun eshell-command-result-p (text regexp &optional func) "Insert a command at the end of the buffer." diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 6aeefdfde2..542815df80 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -232,9 +232,8 @@ chars" (with-temp-eshell (eshell-insert-command "echo alpha") (eshell-kill-output) - (eshell-match-result (regexp-quote "*** output flushed ***\n")) - (should (forward-line)) - (should (= (point) eshell-last-output-start)))) + (eshell-match-result + (concat "^" (regexp-quote "*** output flushed ***\n") "$")))) (ert-deftest eshell-test/run-old-command () "Re-run an old command" commit 1693423fd74d882f7e682a65136c1111e253058a Author: Sean Whitton Date: Fri Jan 21 22:32:22 2022 -0700 Move Eshell test helpers to their own file * test/lisp/eshell/eshell-tests.el: * test/lisp/eshell/eshell-tests-helpers.el: Move helpers to own file. diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el new file mode 100644 index 0000000000..2afa63ae51 --- /dev/null +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -0,0 +1,90 @@ +;;; eshell-tests-helpers.el --- Eshell test suite helpers -*- lexical-binding:t -*- + +;; Copyright (C) 1999-2022 Free Software Foundation, Inc. + +;; Author: John Wiegley + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Eshell test suite helpers. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'esh-mode) +(require 'eshell) + +(defvar eshell-test--max-subprocess-time 5 + "The maximum amount of time to wait for a subprocess to finish, in seconds. +See `eshell-wait-for-subprocess'.") + +(defmacro with-temp-eshell (&rest body) + "Evaluate BODY in a temporary Eshell buffer." + `(ert-with-temp-directory eshell-directory-name + (let* (;; We want no history file, so prevent Eshell from falling + ;; back on $HISTFILE. + (process-environment (cons "HISTFILE" process-environment)) + (eshell-history-file-name nil) + (eshell-buffer (eshell t))) + (unwind-protect + (with-current-buffer eshell-buffer + ,@body) + (let (kill-buffer-query-functions) + (kill-buffer eshell-buffer)))))) + +(defun eshell-wait-for-subprocess () + "Wait until there is no interactive subprocess running in Eshell. +If this takes longer than `eshell-test--max-subprocess-time', +raise an error." + (let ((start (current-time))) + (while (eshell-interactive-process) + (when (> (float-time (time-since start)) + eshell-test--max-subprocess-time) + (error "timed out waiting for subprocess")) + (sit-for 0.1)))) + +(defun eshell-insert-command (text &optional func) + "Insert a command at the end of the buffer." + (goto-char eshell-last-output-end) + (insert-and-inherit text) + (funcall (or func 'eshell-send-input))) + +(defun eshell-match-result (regexp) + "Check that text after `eshell-last-input-end' matches REGEXP." + (goto-char eshell-last-input-end) + (should (string-match-p regexp (buffer-substring-no-properties + (point) (point-max))))) + +(defun eshell-command-result-p (text regexp &optional func) + "Insert a command at the end of the buffer." + (eshell-insert-command text func) + (eshell-wait-for-subprocess) + (eshell-match-result regexp)) + +(defvar eshell-history-file-name) + +(defun eshell-test-command-result (command) + "Like `eshell-command-result', but not using HOME." + (ert-with-temp-directory eshell-directory-name + (let ((eshell-history-file-name nil)) + (eshell-command-result command)))) + +(provide 'eshell-tests) + +;;; eshell-tests.el ends here diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 1a7ab0ab06..6aeefdfde2 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -29,61 +29,16 @@ (require 'ert-x) (require 'esh-mode) (require 'eshell) - -(defvar eshell-test--max-subprocess-time 5 - "The maximum amount of time to wait for a subprocess to finish, in seconds. -See `eshell-wait-for-subprocess'.") - -(defmacro with-temp-eshell (&rest body) - "Evaluate BODY in a temporary Eshell buffer." - `(ert-with-temp-directory eshell-directory-name - (let* (;; We want no history file, so prevent Eshell from falling - ;; back on $HISTFILE. - (process-environment (cons "HISTFILE" process-environment)) - (eshell-history-file-name nil) - (eshell-buffer (eshell t))) - (unwind-protect - (with-current-buffer eshell-buffer - ,@body) - (let (kill-buffer-query-functions) - (kill-buffer eshell-buffer)))))) - -(defun eshell-wait-for-subprocess () - "Wait until there is no interactive subprocess running in Eshell. -If this takes longer than `eshell-test--max-subprocess-time', -raise an error." - (let ((start (current-time))) - (while (eshell-interactive-process) - (when (> (float-time (time-since start)) - eshell-test--max-subprocess-time) - (error "timed out waiting for subprocess")) - (sit-for 0.1)))) - -(defun eshell-insert-command (text &optional func) - "Insert a command at the end of the buffer." - (goto-char eshell-last-output-end) - (insert-and-inherit text) - (funcall (or func 'eshell-send-input))) - -(defun eshell-match-result (regexp) - "Check that text after `eshell-last-input-end' matches REGEXP." - (goto-char eshell-last-input-end) - (should (string-match-p regexp (buffer-substring-no-properties - (point) (point-max))))) - -(defun eshell-command-result-p (text regexp &optional func) - "Insert a command at the end of the buffer." - (eshell-insert-command text func) - (eshell-wait-for-subprocess) - (eshell-match-result regexp)) +(eval-and-compile + (load (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory))))) (defvar eshell-history-file-name) - -(defun eshell-test-command-result (command) - "Like `eshell-command-result', but not using HOME." - (ert-with-temp-directory eshell-directory-name - (let ((eshell-history-file-name nil)) - (eshell-command-result command)))) +(defvar eshell-test--max-subprocess-time) +(declare-function eshell-insert-command "eshell-tests-helpers") +(declare-function eshell-match-result "eshell-tests-helpers") +(declare-function eshell-command-result-p "eshell-tests-helpers") ;;; Tests: commit 422b0f2a505e6e0af9500e4014f3b12c337888a5 Author: Lars Ingebrigtsen Date: Mon Jan 24 20:14:15 2022 +0100 Make hi-lock-face-defaults into a defcustom * lisp/hi-lock.el (hi-lock-face-defaults): Make into defcustom. diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 0f5409ef43..0934eef8ed 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -235,10 +235,12 @@ by cycling through the faces in `hi-lock-face-defaults'." "Human-readable lighters for `hi-lock-interactive-patterns'.") (put 'hi-lock-interactive-lighters 'permanent-local t) -(defvar hi-lock-face-defaults +(defcustom hi-lock-face-defaults '("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-salmon" "hi-aquamarine" "hi-black-b" "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb") - "Default faces for hi-lock interactive functions.") + "Default face names for hi-lock interactive functions." + :type '(repeat string) + :version "29.1") (defvar hi-lock-file-patterns-prefix "Hi-lock" "String used to identify hi-lock patterns at the start of files.") commit 7f7b418ae6321b2164e616941f77a498fb222b57 Author: Juri Linkov Date: Mon Jan 24 21:15:37 2022 +0200 * lisp/hi-lock.el (hi-lock-use-overlays): New variable. (hi-lock-set-pattern): Use it. Set overlay priority to 1. (bug#53155) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index a44d6ea10b..0f5409ef43 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -738,6 +738,17 @@ with completion and history." (add-to-list 'hi-lock-face-defaults face t)) (intern face))) +(defvar hi-lock-use-overlays nil + "Whether to always use overlays instead of font-lock rules. +When font-lock-mode is enabled and the buffer specifies font-lock rules, +highlighting is performed by adding new font-lock rules to the existing ones, +so when new matching strings are added, they are highlighted by font-lock. +Otherwise, overlays are used, but new highlighting overlays are not added +when new matching strings are inserted to the buffer. +However, sometimes overlays are still preferable even in buffers +where font-lock is enabled, when hi-lock overlays take precedence +over other overlays in the same buffer.") + (defun hi-lock-set-pattern (regexp face &optional subexp lighter case-fold spaces-regexp) "Highlight SUBEXP of REGEXP with face FACE. If omitted or nil, SUBEXP defaults to zero, i.e. the entire @@ -759,7 +770,8 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search." (add-to-list 'hi-lock--unused-faces (face-name face)) (push pattern hi-lock-interactive-patterns) (push (cons (or lighter regexp) pattern) hi-lock-interactive-lighters) - (if (and font-lock-mode (font-lock-specified-p major-mode)) + (if (and font-lock-mode (font-lock-specified-p major-mode) + (not hi-lock-use-overlays)) (progn (font-lock-add-keywords nil (list pattern) t) (font-lock-flush)) @@ -781,6 +793,8 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search." (match-end subexp)))) (overlay-put overlay 'hi-lock-overlay t) (overlay-put overlay 'hi-lock-overlay-regexp (or lighter regexp)) + ;; Use priority higher than default used by e.g. diff-refine. + (overlay-put overlay 'priority 1) (overlay-put overlay 'face face)) (goto-char (match-end 0))) (when no-matches commit ee0848171262f7fc693b18e4bf04e9f9c98d1e88 Author: Lars Ingebrigtsen Date: Mon Jan 24 20:02:26 2022 +0100 Add NEWS entry for term-clear-full-screen-programs diff --git a/etc/NEWS b/etc/NEWS index 7d1400d7c8..46a734e854 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -92,6 +92,13 @@ time. * Incompatible changes in Emacs 29.1 +--- +** New user option 'term-clear-full-screen-programs'. +By default, term will now work like most terminals when displaying +full-screen programs: When they exit, the output is cleared, leaving +what was displayed in the window before the programs started. Set +this user option to nil to revert back to the old behavior. + --- ** Support for old EIEIO functions is not autoloaded any more. You need an explicit '(require 'eieio-compat)' to use 'defmethod' commit 81886aeaffe76fd95e299403ef493a76bf606825 Author: Miha Rihtaršič Date: Sun Jan 23 21:13:24 2022 +0100 Implement alternative sub-buffer support in term.el * etc/e/eterm-color.ti: Added termcaps for entering and leaving an alternative sub-buffer. * lisp/term.el (term-reset-size): Resize correctly in an alternative sub-buffer is in use. (term-clear-full-screen-programs): New user option. (term-handle-ansi-escape): (term-termcap-format): Handle termcaps for entering and leaving an alternative sub-buffer. (term-switch-to-alternate-sub-buffer): New (used to be commented out) function to enter or leave an alternative sub-buffer. bug#53485 diff --git a/etc/e/eterm-color b/etc/e/eterm-color index bf44fa0f36..fadac25ffc 100644 Binary files a/etc/e/eterm-color and b/etc/e/eterm-color differ diff --git a/etc/e/eterm-color.ti b/etc/e/eterm-color.ti index eeb9b0b6e6..84b27aef5d 100644 --- a/etc/e/eterm-color.ti +++ b/etc/e/eterm-color.ti @@ -16,6 +16,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96, am, mir, msgr, + nrrmc, xenl, bel=^G, blink=\E[5m, @@ -77,8 +78,8 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96, smso=\E[7m, u6=\E[%i%d;%dR, u7=\E[6n, -# smcup=\E[?47h, -# rmcup=\E[?47l, + smcup=\E[47h, + rmcup=\E[47l, # rs2 may need to be added eterm-direct|Emacs term.el with direct-color indexing term-protocol-version 0.96, diff --git a/etc/e/eterm-direct b/etc/e/eterm-direct index c113c37136..f4c16621eb 100644 Binary files a/etc/e/eterm-direct and b/etc/e/eterm-direct differ diff --git a/lisp/term.el b/lisp/term.el index 895dfbed6c..0c8763b462 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -523,6 +523,16 @@ This means text can automatically reflow if the window is resized." (make-obsolete-variable 'term-suppress-hard-newline nil "27.1") +(defcustom term-clear-full-screen-programs t + "Whether to clear contents of full-screen TUI programs after exit. +If non-nil, output of full-screen TUI programs is cleared after +exiting them. Note however that a minority of such programs +don't send an appropriate escape sequence to the terminal before +exiting so their output isn't cleared regardless of this option." + :version "29.1" + :type 'boolean + :group 'term) + ;; Where gud-display-frame should put the debugging arrow. This is ;; set by the marker-filter, which scans the debugger's output for ;; indications of the current pc. @@ -1270,7 +1280,8 @@ Entry to this mode runs the hooks on `term-mode-hook'." (when (/= width term-width) (save-excursion (term--remove-fake-newlines))) - (let ((point (point))) + (let ((point (point)) + (home-marker (marker-position term-home-marker))) (setq term-height height) (setq term-width width) (setq term-start-line-column nil) @@ -1279,11 +1290,20 @@ Entry to this mode runs the hooks on `term-mode-hook'." (term--reset-scroll-region) ;; `term-set-scroll-region' causes these to be set, we have to ;; clear them again since we're changing point (Bug#30544). + (term--unwrap-visible-long-lines width) (setq term-start-line-column nil) (setq term-current-row nil) (setq term-current-column nil) - (goto-char point)) - (term--unwrap-visible-long-lines width))) + (goto-char point) + + (when (term-using-alternate-sub-buffer) + (term-handle-deferred-scroll) + ;; When using an alternative sub-buffer, the home marker should + ;; not move forward. Bring it back by deleting text in front of + ;; it. + (when (> term-home-marker home-marker) + (let ((inhibit-read-only t)) + (delete-region home-marker term-home-marker))))))) ;; Recursive routine used to check if any string in term-kill-echo-list ;; matches part of the buffer before point. @@ -1611,6 +1631,7 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.") "%s%s:li#%d:co#%d:cl=\\E[H\\E[J:cd=\\E[J:bs:am:xn:cm=\\E[%%i%%d;%%dH\ :nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\ :al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=^J\ +:NR:te=\\E[47l:ti=\\E[47h\ :dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\ :mb=\\E[5m:mh=\\E[2m:ZR=\\E[23m:ZH=\\E[3m\ :so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\ @@ -3539,16 +3560,14 @@ otherwise use the current foreground color." ((eq char ?h) (cond ((eq (car params) 4) ;; (terminfo: smir) (setq term-insert-mode t)) - ;; ((eq (car params) 47) ;; (terminfo: smcup) - ;; (term-switch-to-alternate-sub-buffer t)) - )) + ((eq (car params) 47) ;; (terminfo: smcup) + (term-switch-to-alternate-sub-buffer t)))) ;; \E[?l - DEC Private Mode Reset ((eq char ?l) (cond ((eq (car params) 4) ;; (terminfo: rmir) (setq term-insert-mode nil)) - ;; ((eq (car params) 47) ;; (terminfo: rmcup) - ;; (term-switch-to-alternate-sub-buffer nil)) - )) + ((eq (car params) 47) ;; (terminfo: rmcup) + (term-switch-to-alternate-sub-buffer nil)))) ;; Modified to allow ansi coloring -mm ;; \E[m - Set/reset modes, set bg/fg @@ -3595,32 +3614,35 @@ The top-most line is line 0." (term-move-columns (- (term-current-column))) (term-goto 0 0)) -;; (defun term-switch-to-alternate-sub-buffer (set) -;; ;; If asked to switch to (from) the alternate sub-buffer, and already (not) -;; ;; using it, do nothing. This test is needed for some programs (including -;; ;; Emacs) that emit the ti termcap string twice, for unknown reason. -;; (term-handle-deferred-scroll) -;; (if (eq set (not (term-using-alternate-sub-buffer))) -;; (let ((row (term-current-row)) -;; (col (term-horizontal-column))) -;; (cond (set -;; (goto-char (point-max)) -;; (if (not (eq (preceding-char) ?\n)) -;; (term-insert-char ?\n 1)) -;; (setq term-scroll-with-delete t) -;; (setq term-saved-home-marker (copy-marker term-home-marker)) -;; (set-marker term-home-marker (point))) -;; (t -;; (setq term-scroll-with-delete -;; (not (and (= term-scroll-start 0) -;; (= term-scroll-end term-height)))) -;; (set-marker term-home-marker term-saved-home-marker) -;; (set-marker term-saved-home-marker nil) -;; (setq term-saved-home-marker nil) -;; (goto-char term-home-marker))) -;; (setq term-current-column nil) -;; (setq term-current-row 0) -;; (term-goto row col)))) +(defun term-switch-to-alternate-sub-buffer (set) + ;; If asked to switch to (from) the alternate sub-buffer, and already (not) + ;; using it, do nothing. This test is needed for some programs (including + ;; Emacs) that emit the ti termcap string twice, for unknown reason. + (term-handle-deferred-scroll) + (when (eq set (not (term-using-alternate-sub-buffer))) + (cond + (set + (goto-char (point-max)) + (if (not (eq (preceding-char) ?\n)) + (term-insert-char ?\n 1)) + (setq term-scroll-with-delete t) + (setq term-saved-home-marker (copy-marker term-home-marker)) + (set-marker term-home-marker (point))) + (t + (setq term-scroll-with-delete + (not (and (= term-scroll-start 0) + (= term-scroll-end (term--last-line))))) + (goto-char (point-max)) + (when term-clear-full-screen-programs + (delete-region term-home-marker (point)) + (set-marker term-home-marker term-saved-home-marker)) + (set-marker term-saved-home-marker nil) + (setq term-saved-home-marker nil))) + + (setq term-start-line-column nil) + (setq term-current-column nil) + (setq term-current-row nil) + (term-handle-deferred-scroll))) ;; Default value for the symbol term-command-function. commit b93902e22bb517d0992ae09838935647e3594a4b Author: Juri Linkov Date: Mon Jan 24 20:52:59 2022 +0200 * lisp/info.el (Info-link-keymap): Fix repetitive clicks on the header line. Rebind [header-line mouse-1] from mouse-select-window to Info-mouse-follow-link. It selects the window anyway, but also allows repetitively clicking on the Next button on the Info header line (bug#53170). diff --git a/lisp/info.el b/lisp/info.el index f4f0f9790c..bb8cd0d312 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4693,7 +4693,7 @@ the variable `Info-file-list-for-emacs'." (defvar Info-link-keymap (let ((keymap (make-sparse-keymap))) (define-key keymap [header-line down-mouse-1] 'mouse-drag-header-line) - (define-key keymap [header-line mouse-1] 'mouse-select-window) + (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link) (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link) (define-key keymap [mouse-2] 'Info-mouse-follow-link) (define-key keymap [follow-link] 'mouse-face) commit ee87c2f8ca30e9b4221656b00abb25ee9f532040 Author: Lars Ingebrigtsen Date: Mon Jan 24 19:51:55 2022 +0100 Don't list the default hi-lock faces twice in the future history * lisp/hi-lock.el (hi-lock-read-face-name): Don't include faces twice in the defaults (bug#19877). diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 0a01d90cbb..a44d6ea10b 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -723,9 +723,11 @@ with completion and history." (when hi-lock-interactive-patterns (face-name (hi-lock-keyword->face (car hi-lock-interactive-patterns))))) - (defaults (append hi-lock--unused-faces - (cdr (member last-used-face hi-lock-face-defaults)) - hi-lock-face-defaults)) + (defaults (seq-uniq + (append hi-lock--unused-faces + (cdr (member last-used-face hi-lock-face-defaults)) + hi-lock-face-defaults) + #'equal)) face) (if (and hi-lock-auto-select-face (not current-prefix-arg)) (setq face (or (pop hi-lock--unused-faces) (car defaults))) commit 8f16b1aef1b194a0b56bcc3a8647620828954015 Author: Lars Ingebrigtsen Date: Mon Jan 24 19:41:15 2022 +0100 Fix gnus-article-truncate-lines doc string * lisp/gnus/gnus-art.el (gnus-article-truncate-lines): Fix doc string. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 9bb74e8085..08e1a6f93e 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2326,9 +2326,7 @@ This only works if the article in question is HTML." (goto-char (point-max)))))) (defcustom gnus-article-truncate-lines (default-value 'truncate-lines) - "Value of `truncate-lines' in Gnus Article buffer. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." + "Value of `truncate-lines' in Gnus Article buffer." :version "23.1" ;; No Gnus :group 'gnus-article ;; :link '(custom-manual "(gnus)Customizing Articles") commit 28a0d0037c36f4675086f580eec535a85ae1d8bb Author: Juri Linkov Date: Mon Jan 24 20:45:53 2022 +0200 * etc/NEWS: Mention 'replace-regexp-function' (bug#52558). diff --git a/etc/NEWS b/etc/NEWS index 3f6b2d2a1f..7d1400d7c8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1186,6 +1186,10 @@ searchable data, like image data) with a 'display' text property. It marks the image with the 'inhibit-isearch' text property, which inhibits 'isearch' matching the STRING parameter. +--- +** New function 'replace-regexp-function'. +It can be used to implement own regexp syntax for search/replace. + --- ** New user option 'pp-use-max-width'. If non-nil, 'pp' will attempt to limit the line length when formatting commit 2166b1e65e1bca9e091461c92d986b0cf49273d5 Author: Juri Linkov Date: Mon Jan 24 20:28:10 2022 +0200 * lisp/faces.el (read-face-name): Support a list of defaults for M-n. When MULTIPLE is nil and the arg DEFAULT is a list, keep its elements in the "future history" of the minibuffer retrieved by `M-n M-n ...'. (bug#53255) diff --git a/lisp/faces.el b/lisp/faces.el index bb9b1e979f..5e0be11828 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1081,64 +1081,66 @@ That is, if DEFAULT is a list and MULTIPLE is nil, the first element of DEFAULT is returned. If DEFAULT isn't a list, but MULTIPLE is non-nil, a one-element list containing DEFAULT is returned. Otherwise, DEFAULT is returned verbatim." - (unless (listp default) - (setq default (list default))) - (when default - (setq default - (if multiple - (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f)) - default ", ") - ;; If we only want one, and the default is more than one, - ;; discard the unwanted ones. - (setq default (car default)) - (if (symbolp default) - (symbol-name default) - default)))) - (when (and default (not multiple)) - (require 'crm) - ;; For compatibility with `completing-read-multiple' use `crm-separator' - ;; to define DEFAULT if MULTIPLE is nil. - (setq default (car (split-string default crm-separator t)))) - - ;; Older versions of `read-face-name' did not append ": " to the - ;; prompt, so there are third party libraries that have that in the - ;; prompt. If so, remove it. - (setq prompt (replace-regexp-in-string ": ?\\'" "" prompt)) - (let ((prompt (if default - (format-prompt prompt default) - (format "%s: " prompt))) - (completion-extra-properties - '(:affixation-function - (lambda (faces) - (mapcar - (lambda (face) - (list (concat (propertize "SAMPLE" 'face face) - "\t") - "" - face)) - faces)))) - aliasfaces nonaliasfaces faces) - ;; Build up the completion tables. - (mapatoms (lambda (s) - (if (facep s) - (if (get s 'face-alias) - (push (symbol-name s) aliasfaces) - (push (symbol-name s) nonaliasfaces))))) - (if multiple - (progn - (dolist (face (completing-read-multiple - prompt - (completion-table-in-turn nonaliasfaces aliasfaces) - nil t nil 'face-name-history default)) - ;; Ignore elements that are not faces - ;; (for example, because DEFAULT was "all faces") - (if (facep face) (push (intern face) faces))) - (nreverse faces)) - (let ((face (completing-read - prompt - (completion-table-in-turn nonaliasfaces aliasfaces) - nil t nil 'face-name-history default))) - (if (facep face) (intern face)))))) + (let (defaults) + (unless (listp default) + (setq default (list default))) + (when default + (setq default + (if multiple + (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f)) + default ", ") + ;; If we only want one, and the default is more than one, + ;; discard the unwanted ones and use them only in the + ;; "future history" retrieved via `M-n M-n ...'. + (setq defaults default default (car default)) + (if (symbolp default) + (symbol-name default) + default)))) + (when (and default (not multiple)) + (require 'crm) + ;; For compatibility with `completing-read-multiple' use `crm-separator' + ;; to define DEFAULT if MULTIPLE is nil. + (setq default (car (split-string default crm-separator t)))) + + ;; Older versions of `read-face-name' did not append ": " to the + ;; prompt, so there are third party libraries that have that in the + ;; prompt. If so, remove it. + (setq prompt (replace-regexp-in-string ": ?\\'" "" prompt)) + (let ((prompt (if default + (format-prompt prompt default) + (format "%s: " prompt))) + (completion-extra-properties + '(:affixation-function + (lambda (faces) + (mapcar + (lambda (face) + (list (concat (propertize "SAMPLE" 'face face) + "\t") + "" + face)) + faces)))) + aliasfaces nonaliasfaces faces) + ;; Build up the completion tables. + (mapatoms (lambda (s) + (if (facep s) + (if (get s 'face-alias) + (push (symbol-name s) aliasfaces) + (push (symbol-name s) nonaliasfaces))))) + (if multiple + (progn + (dolist (face (completing-read-multiple + prompt + (completion-table-in-turn nonaliasfaces aliasfaces) + nil t nil 'face-name-history default)) + ;; Ignore elements that are not faces + ;; (for example, because DEFAULT was "all faces") + (if (facep face) (push (intern face) faces))) + (nreverse faces)) + (let ((face (completing-read + prompt + (completion-table-in-turn nonaliasfaces aliasfaces) + nil t nil 'face-name-history defaults))) + (if (facep face) (intern face))))))) ;; Not defined without X, but behind window-system test. (defvar x-bitmap-file-path) commit fbf475778459bc3a6b088e05e6839dc66c2caab5 Author: Glenn Morris Date: Mon Jan 24 10:16:36 2022 -0800 * lisp/minibuffer.el (completions-sort): Fix type. Flagged by test-custom-opts. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ecede9479d..917879fb69 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1182,7 +1182,7 @@ function takes and returns a list of completion candidate strings." :type '(choice (const :tag "No sorting" nil) (const :tag "Alphabetical sorting" alphabetical) - function :tag "Custom function") + (function :tag "Custom function")) :version "29.1") (defcustom completions-group nil commit 701ec0bda2b15fc97af6ca68fb842fb1ec9aac35 Author: Lars Ingebrigtsen Date: Mon Jan 24 18:17:10 2022 +0100 Don't output spurious prefixes in read-char-exclusive * src/keyboard.c (read_char): Don't touch the echo area if Vecho_keystrokes is nil. * src/lread.c (read_filtered_event): Bind echo_keystrokes to nil to avoid outputting prefixes we're not going to act on anyway (bug#19718). diff --git a/src/keyboard.c b/src/keyboard.c index 441c23e10c..9242e8dc62 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3059,12 +3059,13 @@ read_char (int commandflag, Lisp_Object map, /* Now wipe the echo area, except for help events which do their own stuff with the echo area. */ - if (!CONSP (c) - || (!(EQ (Qhelp_echo, XCAR (c))) - && !(EQ (Qswitch_frame, XCAR (c))) - /* Don't wipe echo area for select window events: These might - get delayed via `mouse-autoselect-window' (Bug#11304). */ - && !(EQ (Qselect_window, XCAR (c))))) + if (!NILP (Vecho_keystrokes) + && (!CONSP (c) + || (!(EQ (Qhelp_echo, XCAR (c))) + && !(EQ (Qswitch_frame, XCAR (c))) + /* Don't wipe echo area for select window events: These might + get delayed via `mouse-autoselect-window' (Bug#11304). */ + && !(EQ (Qselect_window, XCAR (c)))))) { if (!NILP (echo_area_buffer[0])) { diff --git a/src/lread.c b/src/lread.c index 9910db27de..ec54d2d81a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -705,8 +705,13 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, /* Read until we get an acceptable event. */ retry: do - val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0, - NUMBERP (seconds) ? &end_time : NULL); + { + ptrdiff_t count = SPECPDL_INDEX (); + specbind (Qecho_keystrokes, Qnil); + val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0, + NUMBERP (seconds) ? &end_time : NULL); + unbind_to (count, Qnil); + } while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */ if (BUFFERP (val)) commit 7e653ee73f98ab2ad2061f211d3d57be805d7231 Author: Lars Ingebrigtsen Date: Mon Jan 24 17:22:49 2022 +0100 Allow sorting in electric-buffer-list with `S' * lisp/ebuff-menu.el (electric-buffer-menu-mode-map): Add the `S' sorting command here, too (bug#20178). diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 0c3d4af569..2b1fc916d9 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -48,6 +48,7 @@ (define-key map "\C-m" #'Electric-buffer-menu-select) (define-key map "\C-l" #'recenter) (define-key map "s" #'Buffer-menu-save) + (define-key map "S" #'tabulated-list-sort) (define-key map "d" #'Buffer-menu-delete) (define-key map "k" #'Buffer-menu-delete) (define-key map "\C-d" #'Buffer-menu-delete-backwards) commit f4bfe7834a955c521a4c09187b72fc4e8d6d88a3 Author: Amin Bandali Date: Mon Jan 24 10:59:05 2022 -0500 ERC: Add new comaintainer, F. Jason Park * lisp/erc/erc*.el: Add J.P. as my comaintainer to headers. diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el index 979f93f693..8d970bd6b9 100644 --- a/lisp/erc/erc-autoaway.el +++ b/lisp/erc/erc-autoaway.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcAutoAway ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index d54e92011b..398fe6cc9e 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -4,7 +4,7 @@ ;; Filename: erc-backend.el ;; Author: Lawrence Mitchell -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Created: 2004-05-7 ;; Keywords: comm, IRC, chat, client, internet diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 680de6d5aa..0e7d0d584f 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1996-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm, irc, button, url, regexp ;; URL: https://www.emacswiki.org/emacs/ErcButton diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 7b7773d5e1..8d0f40af99 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2006-2022 Free Software Foundation, Inc. -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park -; This file is part of GNU Emacs. +;; 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 diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 00addde275..16cfb15a5a 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2003, 2005-2022 Free Software Foundation, Inc. ;; Author: Alex Schroeder -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ERC ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 9654cab6e5..cc4143bfa2 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -5,7 +5,7 @@ ;; Author: Ben A. Mesander ;; Noah Friedman ;; Per Persson -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; Created: 1994-01-23 diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index 8ece765ef0..1897f53dc1 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. ;; Author: Julien Danjou -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index 8f46a1c8dd..958783f239 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Andreas Fuchs -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 492830c3e1..140e7fdfc6 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -4,7 +4,7 @@ ;; Author: Andreas Fuchs ;; Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcFilling ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 9b9f19a0db..8fef23945d 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2022 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Most code is taken verbatim from erc.el, see there for the original ;; authors. diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el index f1184ff5eb..417c0b898a 100644 --- a/lisp/erc/erc-ibuffer.el +++ b/lisp/erc/erc-ibuffer.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el index eab219f4c1..5c0a2c1a48 100644 --- a/lisp/erc/erc-identd.el +++ b/lisp/erc/erc-identd.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003, 2006-2022 Free Software Foundation, Inc. ;; Author: John Wiegley -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index ea4f44b91c..64a8f82b2a 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcImenu diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 175e83f3c9..b9788c192b 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Alex Schroeder -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm, irc ;; URL: https://www.emacswiki.org/emacs/ErcAutoJoin diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el index 354203aa09..b65f4dbf6a 100644 --- a/lisp/erc/erc-lang.el +++ b/lisp/erc/erc-lang.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Alex Schroeder -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Old-Version: 1.0.0 ;; URL: https://www.emacswiki.org/emacs/ErcLang ;; Keywords: comm diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index c7cd0ceba8..5266b680c3 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2008-2022 Free Software Foundation, Inc. ;; Author: Tom Tromey -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Old-Version: 0.1 ;; URL: https://www.emacswiki.org/emacs/ErcList ;; Keywords: comm diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 056701d620..57093d3fc6 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003-2022 Free Software Foundation, Inc. ;; Author: Lawrence Mitchell -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcLogging ;; Keywords: comm, IRC, chat, client, Internet, logging diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index aa78590539..7c9174ff66 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2022 Free Software Foundation, Inc. ;; Author: Andreas Fuchs -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcMatch diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index fd14d8b0ad..455a7c3cd2 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2002, 2004-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm, menu ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index 30bb18344d..17ed881b12 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 9377e701c3..553697ae84 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index a3fe04d392..911a574b17 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcNotify ;; Keywords: comm diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el index e53178ce63..087e5a67d0 100644 --- a/lisp/erc/erc-page.el +++ b/lisp/erc/erc-page.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 384be500ad..af8528dbc3 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Sacha Chua -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcCompletion diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el index ec4bf3ae53..e46862d6a6 100644 --- a/lisp/erc/erc-replace.el +++ b/lisp/erc/erc-replace.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2022 Free Software Foundation, Inc. ;; Author: Andreas Fuchs -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcReplace ;; Keywords: comm, IRC, client, Internet diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 0f6851a98a..9dd1fab640 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Alex Schroeder -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcHistory diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 4b3ca7d23f..cc5d5701e4 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcNickserv ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el index 86978f9d79..5cae64572f 100644 --- a/lisp/erc/erc-sound.el +++ b/lisp/erc/erc-sound.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2002-2003, 2006-2022 Free Software Foundation, Inc. -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcSound ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index ead0d374b1..5b06c21612 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -4,7 +4,7 @@ ;; Author: Mario Lang ;; Contributor: Eric M. Ludlam -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcSpeedbar ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el index d9cfc9bc98..91e6777b7c 100644 --- a/lisp/erc/erc-spelling.el +++ b/lisp/erc/erc-spelling.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2005-2022 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm, irc ;; URL: https://www.emacswiki.org/emacs/ErcSpelling diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index d74a53bc71..cdab3241c1 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm, timestamp ;; URL: https://www.emacswiki.org/emacs/ErcStamp diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el index 39430ee659..8997be00ae 100644 --- a/lisp/erc/erc-status-sidebar.el +++ b/lisp/erc/erc-status-sidebar.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017, 2020-2022 Free Software Foundation, Inc. ;; Author: Andrew Barbarello -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://github.com/drewbarbs/erc-status-sidebar ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 2196c5411e..9118d7b994 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcChannelTracking diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 8a8842bc48..d998718a8f 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Andreas Fuchs -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; URL: https://www.emacswiki.org/emacs/ErcTruncation ;; Keywords: IRC, chat, client, Internet, logging diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el index ee2a8c936f..ca8ff6c080 100644 --- a/lisp/erc/erc-xdcc.el +++ b/lisp/erc/erc-xdcc.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5faeda9a13..9ee8d38b02 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1997-2022 Free Software Foundation, Inc. ;; Author: Alexander L. Belikoff (alexander@belikoff.net) -;; Maintainer: Amin Bandali +;; Maintainer: Amin Bandali , F. Jason Park ;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu), ;; Mario Lang (mlang@delysid.org), ;; Alex Schroeder (alex@gnu.org) commit 5909b271448e37ba6f71de4b754d1dab6be6875d Author: Lars Ingebrigtsen Date: Mon Jan 24 15:19:38 2022 +0100 Fix \href{a_b} in tex-mode * lisp/textmodes/tex-mode.el (tex-font-lock-keywords-2): Fontify href parameters like constants so that _ aren't fontified like subscripts. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 1925d93d93..f41cc2c15e 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -578,6 +578,9 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; "caption" "footnote" "footnotemark" "footnotetext" ) t)) + (file-like (regexp-opt + '("href" "ProvidesFile") + t)) ;; ;; Names of commands that should be fontified. (specials-1 (regexp-opt '("\\" "\\*") t)) ;; "-" @@ -598,6 +601,8 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; ;; Citation args. (list (concat slash citations opt arg) 3 'font-lock-constant-face) + ;; File-like args. + (list (concat slash file-like opt arg) 3 'font-lock-constant-face) ;; ;; Text between `` quotes ''. (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) commit 8c37b9042eb78beead4e3e85273e4543523abcca Author: Lars Ingebrigtsen Date: Mon Jan 24 15:15:59 2022 +0100 Revert "Fix tex-mode handling of _ chars in href{} commands" This reverts commit 487a0be7f7eb0ca9402247f13a11e39aa2946d05. This will be fixed a different way. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 929181960b..1925d93d93 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -630,14 +630,6 @@ An alternative value is \" . \", if you use a font with a narrow period." 3 '(tex-font-lock-append-prop 'bold) 'append))))) "Gaudy expressions to highlight in TeX modes.") -(defun tex--current-command () - "Return the previous \\\\command." - (save-excursion - (and (re-search-backward "\\\\\\([a-zA-Z@]+\\)\\*?\\({\\)?" nil t) - ;; Ignore commands that don't have contents. - (and (match-string 2) - (match-string 1))))) - (defun tex-font-lock-suscript (pos) (unless (or (memq (get-text-property pos 'face) '(font-lock-constant-face font-lock-builtin-face @@ -647,9 +639,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (pos pos)) (while (eq (char-before pos) ?\\) (setq pos (1- pos) odd (not odd))) - odd) - ;; Allow bare _ characters in some commands. - (member (tex--current-command) '("href" "ProvidesFile"))) + odd)) (if (eq (char-after pos) ?_) `(face subscript display (raise ,(car tex-font-script-display))) `(face superscript display (raise ,(cadr tex-font-script-display)))))) commit 79d9f3982fe6e558327584099f2efc96e51485a1 Author: Lars Ingebrigtsen Date: Mon Jan 24 15:10:18 2022 +0100 Add derived-mode test for bug#24176 diff --git a/test/lisp/emacs-lisp/derived-tests.el b/test/lisp/emacs-lisp/derived-tests.el index d867a18183..0589819ccc 100644 --- a/test/lisp/emacs-lisp/derived-tests.el +++ b/test/lisp/emacs-lisp/derived-tests.el @@ -40,4 +40,22 @@ (derived-tests--child-mode) (should (equal (buffer-string) "PB CB MH AFP=S AFC=S "))))) +(ert-deftest test-add-font-lock () + (define-derived-mode mode-a fundamental-mode "mode-a" + (font-lock-add-keywords nil `(("a" 0 'font-lock-keyword-face)))) + (define-derived-mode mode-b mode-a "mode-b" + (font-lock-add-keywords nil `(("b" 0 'font-lock-builtin-face)))) + (define-derived-mode mode-c mode-b "mode-c" + (font-lock-add-keywords nil `(("c" 0 'font-lock-constant-face)))) + + (with-temp-buffer + (mode-c) + (should (equal font-lock-keywords + '(t (("c" 0 'font-lock-constant-face) + ("b" 0 'font-lock-builtin-face) + ("a" 0 'font-lock-keyword-face)) + ("c" (0 'font-lock-constant-face)) + ("b" (0 'font-lock-builtin-face)) + ("a" (0 'font-lock-keyword-face))))))) + ;;; derived-tests.el ends here commit ffb0e8c4eff43a31bfb95eaf8b9db9d3c400e5ae Author: Lars Ingebrigtsen Date: Mon Jan 24 15:05:28 2022 +0100 Make anonymous functions work in auto-mode-alist * lisp/files.el (set-auto-mode--apply-alist): Don't infloop on anonymous functions in auto-mode-alist (bug#20709). diff --git a/lisp/files.el b/lisp/files.el index e021545cf1..aabe8f445e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3249,6 +3249,7 @@ extra checks should be done." (let ((case-fold-search t)) (assoc-default name alist 'string-match)))))) (if (and mode + (not (functionp mode)) (consp mode) (cadr mode)) (setq mode (car mode) commit 067e84116dde36a2e058e3915fe81c818a21e40a Author: Mattias Engdegård Date: Mon Jan 24 15:02:17 2022 +0100 ; * src/bytecode.c (exec_byte_code): Silence GCC warning diff --git a/src/bytecode.c b/src/bytecode.c index 76ef2fb661..da1855d6ba 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -381,7 +381,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object *stack_lim = top + stack_items; unsigned char const *bytestr_data = SDATA (bytestr); unsigned char const *pc = bytestr_data; +#if BYTE_CODE_SAFE || !defined NDEBUG ptrdiff_t count = SPECPDL_INDEX (); +#endif /* ARGS_TEMPLATE is composed of bit fields: bits 0..6 minimum number of arguments commit edeb220d310f189023b232407deb55f49445358b Author: Lars Ingebrigtsen Date: Mon Jan 24 14:55:35 2022 +0100 Don't loop so much in gud-query-cmdline on remote systems * lisp/progmodes/gud.el (gud-query-cmdline): Avoid looping over large numbers of files on remote systems (bug#21528). diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index b42279415b..7092ca2041 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -759,13 +759,18 @@ The option \"--fullname\" must be included in this value." (concat (or cmd-name (symbol-name minor-mode)) " " (or init - (let ((file nil)) - (dolist (f (directory-files default-directory) file) - (if (and (file-executable-p f) - (not (file-directory-p f)) - (or (not file) - (file-newer-than-file-p f file))) - (setq file f))))))) + (let ((file nil) + (files (directory-files default-directory))) + ;; On remote systems, this may be slow, so avoid it. + (when (or (not (file-remote-p default-directory)) + (length< files 50)) + (dolist (f files) + (if (and (file-executable-p f) + (not (file-directory-p f)) + (or (not file) + (file-newer-than-file-p f file))) + (setq file f))) + file))))) gud-minibuffer-local-map nil hist-sym))) commit a46421446ff2e97b01434a1d77fa149d985e6c7d Author: Protesilaos Stavrou Date: Wed Jan 19 14:20:19 2022 +0200 Make Completions sorting a user option * etc/NEWS: Document the new user option. * lisp/minibuffer.el (completions-sort): Add new user option. (minibuffer-completion-help): Implement it for the Completions buffer. (Bug#53362) diff --git a/etc/NEWS b/etc/NEWS index 73d12a203e..3f6b2d2a1f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -429,6 +429,11 @@ When non-nil, the commands 'next-completion' and 'previous-completion' automatically wrap around on reaching the beginning or the end of the "*Completions*" buffer. +*** New user option 'completions-sort'. +This option controls the sorting of the completion candidates in +the *Completions* buffer. Available styles are no sorting, +alphabetical (the default), or a custom sort function. + ** Isearch and Replace +++ diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d58c23af8f..ecede9479d 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1173,6 +1173,18 @@ completion candidates than this number." :version "24.1" :type completion--cycling-threshold-type) +(defcustom completions-sort 'alphabetical + "Sort candidates in the *Completions* buffer. + +The value can be nil to disable sorting, `alphabetical' for +alphabetical sorting or a custom sorting function. The sorting +function takes and returns a list of completion candidate +strings." + :type '(choice (const :tag "No sorting" nil) + (const :tag "Alphabetical sorting" alphabetical) + function :tag "Custom function") + :version "29.1") + (defcustom completions-group nil "Enable grouping of completion candidates in the *Completions* buffer. See also `completions-group-format' and `completions-group-sort'." @@ -2268,7 +2280,10 @@ variables.") ;; same, but not always. (setq completions (if sort-fun (funcall sort-fun completions) - (sort completions 'string-lessp))) + (pcase completions-sort + ('nil completions) + ('alphabetical (sort completions #'string-lessp)) + (_ (funcall completions-sort completions))))) ;; After sorting, group the candidates using the ;; `group-function'. commit ead95479032f342eb7a493499f9edc7f2f2ec759 Author: Lars Ingebrigtsen Date: Mon Jan 24 14:00:50 2022 +0100 Allow jumping to ert failure definitions * lisp/emacs-lisp/ert.el (ert-test): (ert-deftest): Store the file name. (ert-test-location): New function. (ert-run-tests-batch): Use it. * lisp/emacs-lisp/find-func.el (find-ert-deftest-regexp): New variable. (find-function-regexp-alist): Add ert-deftest (bug#22471). Based on code by Phillip Lord . diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index b6c5b7d6b9..00da5c718c 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -129,7 +129,8 @@ mode.") (body (cl-assert nil)) (most-recent-result nil) (expected-result-type ':passed) - (tags '())) + (tags '()) + (file-name nil)) (defun ert-test-boundp (symbol) "Return non-nil if SYMBOL names a test." @@ -240,7 +241,8 @@ in batch mode, an error is signalled. `(:expected-result-type ,expected-result)) ,@(when tags-supplied-p `(:tags ,tags)) - :body (lambda () ,@body))) + :body (lambda () ,@body) + :file-name ,(or (macroexp-file-name) buffer-file-name))) ',name)))) (defvar ert--find-test-regexp @@ -1370,6 +1372,22 @@ RESULT must be an `ert-test-result-with-condition'." (defvar ert-quiet nil "Non-nil makes ERT only print important information in batch mode.") +(defun ert-test-location (test) + "Return a string description the source location of TEST." + (when-let ((loc + (ignore-errors + (find-function-search-for-symbol + (ert-test-name test) 'ert-deftest (ert-test-file-name test))))) + (let* ((buffer (car loc)) + (point (cdr loc)) + (file (file-relative-name (buffer-file-name buffer))) + (line (with-current-buffer buffer + (line-number-at-pos point)))) + (format "at %s:%s" file line)))) + +(defvar ert-batch-backtrace-right-margin 70 + "The maximum line length for printing backtraces in `ert-run-tests-batch'.") + ;;;###autoload (defun ert-run-tests-batch (&optional selector) "Run the tests specified by SELECTOR, printing results to the terminal. @@ -1497,14 +1515,17 @@ Returns the stats object." (let* ((max (prin1-to-string (length (ert--stats-tests stats)))) (format-string (concat "%9s %" (prin1-to-string (length max)) - "s/" max " %S (%f sec)"))) + "s/" max " %S (%f sec)%s"))) (message format-string (ert-string-for-test-result result (ert-test-result-expected-p test result)) (1+ (ert--stats-test-pos stats test)) (ert-test-name test) - (ert-test-result-duration result)))))))) + (ert-test-result-duration result) + (if (ert-test-result-expected-p test result) + "" + (concat " " (ert-test-location test)))))))))) nil)) ;;;###autoload diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index c4f48b8a79..6eac25c100 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -123,6 +123,15 @@ should insert the feature name." :group 'xref :version "25.1") +(defcustom find-ert-deftest-regexp + "(ert-deftest +'%s" + "The regexp used to search for an ert-deftest definition. +Note it must contain a `%s' at the place where `format' +should insert the feature name." + :type 'regexp + :group 'xref + :version "29.1") + (defun find-function--defface (symbol) (catch 'found (while (re-search-forward (format find-face-regexp symbol) nil t) @@ -136,7 +145,8 @@ should insert the feature name." (defvar . find-variable-regexp) (defface . find-function--defface) (feature . find-feature-regexp) - (defalias . find-alias-regexp)) + (defalias . find-alias-regexp) + (ert-deftest . find-ert-deftest-regexp)) "Alist mapping definition types into regexp variables. Each regexp variable's value should actually be a format string to be used to substitute the desired symbol name into the regexp. commit d0b9e269ee797cacf079ece5eaa54e846255cdc8 Author: Yuuki Harano Date: Mon Jan 24 21:26:17 2022 +0900 * configure.ac: Remove forgotten GLIB_GSETTINGS call diff --git a/configure.ac b/configure.ac index 515ae82536..e5574b6b05 100644 --- a/configure.ac +++ b/configure.ac @@ -2806,9 +2806,6 @@ if test "${opsys}" != "mingw32"; then AC_DEFINE([GLIB_DISABLE_DEPRECATION_WARNINGS], [1], [Define to 1 to disable Glib deprecation warnings.]) fi - if test "$window_system" = pgtk; then - GLIB_GSETTINGS - fi else check_gtk2=yes gtk3_pkg_errors="$GTK_PKG_ERRORS " commit 933ed56e5538bba8ab604225f101030bf904307b Author: Lars Ingebrigtsen Date: Mon Jan 24 13:02:00 2022 +0100 Add NEWS item for `I' command diff --git a/etc/NEWS b/etc/NEWS index e641eeaa50..73d12a203e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -257,6 +257,11 @@ These will take you (respectively) to the next and previous "page". --- *** 'describe-char' now also outputs the name of emoji combinations. ++++ +*** New key binding in *Help* buffers: 'I'. +This will take you to the Emacs Lisp manual entry for the item +displayed, if any. + ** Outline Mode *** Support for customizing the default visibility state of headings. commit 031c2e46791925d70018945c9cb2c7c7f2c35efe Author: Lars Ingebrigtsen Date: Mon Jan 24 12:59:55 2022 +0100 Add a *Help* command that'll take you to the lispref manual * doc/emacs/help.texi (Help Mode): Document it. * lisp/help-mode.el (help-mode-map): Add an `I' keystroke. (help-goto-lispref-info): New command. * lisp/info-look.el (:mode): Add an entry for the lispref manual. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 5a458209d2..1f743ccd88 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -478,6 +478,9 @@ View the source of the current help topic (if any) (@code{help-view-source}). @item i Look up the current topic in the manual(s) (@code{help-goto-info}). +@item I +Look up the current topic in the Emacs Lisp manual +(@code{help-goto-lispref-info}). @item c Customize the variable or the face (@code{help-customize}). @end table diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 894b2a50aa..5fb5dcfb19 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -45,6 +45,7 @@ (define-key map [XF86Forward] 'help-go-forward) (define-key map "\C-c\C-c" 'help-follow-symbol) (define-key map "s" 'help-view-source) + (define-key map "I" 'help-goto-lispref-info) (define-key map "i" 'help-goto-info) (define-key map "c" 'help-customize) map) @@ -819,6 +820,14 @@ The help buffers are divided into \"pages\" by the ^L character." (info-lookup-symbol (plist-get help-mode--current-data :symbol) 'emacs-lisp-mode)) +(defun help-goto-lispref-info () + "View the Emacs Lisp manual *info* node of the current help item." + (interactive nil help-mode) + (unless help-mode--current-data + (error "No symbol to look up in the current buffer")) + (info-lookup-symbol (plist-get help-mode--current-data :symbol) + 'emacs-lisp-only)) + (defun help-customize () "Customize variable or face whose doc string is shown in the current buffer." (interactive nil help-mode) diff --git a/lisp/info-look.el b/lisp/info-look.el index 64f16df4dc..42e758360e 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -1010,6 +1010,13 @@ Return nil if there is nothing appropriate in the buffer near point." ("(cl)Function Index" nil "^ -+ .*: " "\\( \\|$\\)") ("(cl)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)"))) +(info-lookup-maybe-add-help + :mode 'emacs-lisp-only + :regexp "[^][()`'‘’,\" \t\n]+" + :doc-spec '(("(elisp)Index" nil "^ -+ .*: " "\\( \\|$\\)") + ("(cl)Function Index" nil "^ -+ .*: " "\\( \\|$\\)") + ("(cl)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)"))) + (mapc (lambda (elem) (let* ((prefix (car elem))) commit 487a0be7f7eb0ca9402247f13a11e39aa2946d05 Author: Lars Ingebrigtsen Date: Mon Jan 24 12:39:02 2022 +0100 Fix tex-mode handling of _ chars in href{} commands * lisp/textmodes/tex-mode.el (tex--current-command): New function (bug#23102). (tex-font-lock-suscript): Don't subscript _ chars in href. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 1925d93d93..929181960b 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -630,6 +630,14 @@ An alternative value is \" . \", if you use a font with a narrow period." 3 '(tex-font-lock-append-prop 'bold) 'append))))) "Gaudy expressions to highlight in TeX modes.") +(defun tex--current-command () + "Return the previous \\\\command." + (save-excursion + (and (re-search-backward "\\\\\\([a-zA-Z@]+\\)\\*?\\({\\)?" nil t) + ;; Ignore commands that don't have contents. + (and (match-string 2) + (match-string 1))))) + (defun tex-font-lock-suscript (pos) (unless (or (memq (get-text-property pos 'face) '(font-lock-constant-face font-lock-builtin-face @@ -639,7 +647,9 @@ An alternative value is \" . \", if you use a font with a narrow period." (pos pos)) (while (eq (char-before pos) ?\\) (setq pos (1- pos) odd (not odd))) - odd)) + odd) + ;; Allow bare _ characters in some commands. + (member (tex--current-command) '("href" "ProvidesFile"))) (if (eq (char-after pos) ?_) `(face subscript display (raise ,(car tex-font-script-display))) `(face superscript display (raise ,(cadr tex-font-script-display)))))) commit 77b72f77b3a5d13fc6e71746dee2cf68305057e2 Author: Lars Ingebrigtsen Date: Mon Jan 24 11:55:57 2022 +0100 Make `font-lock-add-keywords' work in derived modes * lisp/font-lock.el (font-lock-set-defaults): Make `font-lock-add-keywords' work in derived modes (bug#24176). diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 083bfb8626..d8a1fe399b 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1906,8 +1906,9 @@ preserve `hi-lock-mode' highlighting patterns." Sets various variables using `font-lock-defaults' and `font-lock-maximum-decoration'." ;; Set fontification defaults if not previously set for correct major mode. - (unless (and font-lock-set-defaults - (eq font-lock-major-mode major-mode)) + (when (or (not font-lock-set-defaults) + (not font-lock-major-mode) + (not (derived-mode-p font-lock-major-mode))) (setq font-lock-major-mode major-mode) (setq font-lock-set-defaults t) (let* ((defaults font-lock-defaults) commit 806a1210070cc3ed9f6433bbd37e3975bc7b4e5c Author: Po Lu Date: Mon Jan 24 18:49:54 2022 +0800 Remove redundant declarations from keyboard.h that are now in lisp.h * src/keyboard.h (process_pending_signals) (pending_signals): Remove declarations. diff --git a/src/keyboard.h b/src/keyboard.h index 167b7d79e8..cd5f677b96 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -486,8 +486,6 @@ extern bool kbd_buffer_events_waiting (void); extern void add_user_signal (int, const char *); extern int tty_read_avail_input (struct terminal *, struct input_event *); -extern bool volatile pending_signals; -extern void process_pending_signals (void); extern struct timespec timer_check (void); extern void mark_kboards (void); commit a8b713d83a5544d144c05aa45c465bbe3ebc8789 Author: Mattias Engdegård Date: Sat Jan 15 16:23:09 2022 +0100 Inline maybe_quit Since `maybe_quit` is called on many critical paths, inline a slightly cheaper condition (that ignores Vinhibit_quit). * src/eval.c (maybe_quit): Rename to `probably_quit`. * src/lisp.h (maybe_quit): New simplified inline function. diff --git a/src/ccl.c b/src/ccl.c index 377eb3a0ea..a3121f7278 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -33,6 +33,7 @@ along with GNU Emacs. If not, see . */ #include "charset.h" #include "ccl.h" #include "coding.h" +#include "keyboard.h" /* Table of registered CCL programs. Each element is a vector of NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the diff --git a/src/eval.c b/src/eval.c index 744fe82347..205a0b0db2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1737,21 +1737,8 @@ process_quit_flag (void) quit (); } -/* Check quit-flag and quit if it is non-nil. Typing C-g does not - directly cause a quit; it only sets Vquit_flag. So the program - needs to call maybe_quit at times when it is safe to quit. Every - loop that might run for a long time or might not exit ought to call - maybe_quit at least once, at a safe place. Unless that is - impossible, of course. But it is very desirable to avoid creating - loops where maybe_quit is impossible. - - If quit-flag is set to `kill-emacs' the SIGINT handler has received - a request to exit Emacs when it is safe to do. - - When not quitting, process any pending signals. */ - void -maybe_quit (void) +probably_quit (void) { if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) process_quit_flag (); diff --git a/src/lisp.h b/src/lisp.h index 54e8c30ccf..9f1d093f58 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3422,12 +3422,34 @@ struct handler extern Lisp_Object memory_signal_data; -extern void maybe_quit (void); - /* True if ought to quit now. */ #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) +extern bool volatile pending_signals; +extern void process_pending_signals (void); +extern void probably_quit (void); + +/* Check quit-flag and quit if it is non-nil. Typing C-g does not + directly cause a quit; it only sets Vquit_flag. So the program + needs to call maybe_quit at times when it is safe to quit. Every + loop that might run for a long time or might not exit ought to call + maybe_quit at least once, at a safe place. Unless that is + impossible, of course. But it is very desirable to avoid creating + loops where maybe_quit is impossible. + + If quit-flag is set to `kill-emacs' the SIGINT handler has received + a request to exit Emacs when it is safe to do. + + When not quitting, process any pending signals. */ + +INLINE void +maybe_quit (void) +{ + if (!NILP (Vquit_flag) || pending_signals) + probably_quit (); +} + /* Process a quit rarely, based on a counter COUNT, for efficiency. "Rarely" means once per USHRT_MAX + 1 times; this is somewhat arbitrary, but efficient. */ commit b7902a9b48f8e7f83ab6b90cfd8bc95aab410e6f Author: Mattias Engdegård Date: Sat Jan 15 14:51:09 2022 +0100 Bump specpdl inline, move reallocation out of line The common case is just to increment `specpdl_ptr`; do that in-line, but move the uncommon reallocation to a separate subroutine. * src/eval.c (grow_specpdl): Now inline, most code moved... (grow_specpdl_allocation): ...here. diff --git a/src/eval.c b/src/eval.c index 7c03006732..744fe82347 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2362,6 +2362,28 @@ alist mapping symbols to their value. */) return unbind_to (count, eval_sub (form)); } +static void +grow_specpdl_allocation (void) +{ + eassert (specpdl_ptr == specpdl + specpdl_size); + + ptrdiff_t count = SPECPDL_INDEX (); + ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); + union specbinding *pdlvec = specpdl - 1; + ptrdiff_t pdlvecsize = specpdl_size + 1; + if (max_size <= specpdl_size) + { + if (max_specpdl_size < 400) + max_size = max_specpdl_size = 400; + if (max_size <= specpdl_size) + xsignal0 (Qexcessive_variable_binding); + } + pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); + specpdl = pdlvec + 1; + specpdl_size = pdlvecsize - 1; + specpdl_ptr = specpdl + count; +} + /* Grow the specpdl stack by one entry. The caller should have already initialized the entry. Signal an error on stack overflow. @@ -2372,29 +2394,12 @@ alist mapping symbols to their value. */) never-used entry just before the bottom of the stack; sometimes its address is taken. */ -static void +INLINE void grow_specpdl (void) { specpdl_ptr++; - if (specpdl_ptr == specpdl + specpdl_size) - { - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); - union specbinding *pdlvec = specpdl - 1; - ptrdiff_t pdlvecsize = specpdl_size + 1; - if (max_size <= specpdl_size) - { - if (max_specpdl_size < 400) - max_size = max_specpdl_size = 400; - if (max_size <= specpdl_size) - xsignal0 (Qexcessive_variable_binding); - } - pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); - specpdl = pdlvec + 1; - specpdl_size = pdlvecsize - 1; - specpdl_ptr = specpdl + count; - } + grow_specpdl_allocation (); } ptrdiff_t commit 4a0541a5ddee0485d19dba1960a3a5821cf68fdd Author: Mattias Engdegård Date: Wed Jan 12 12:05:26 2022 +0100 Implement Ffuncall in terms of funcall_general * src/eval.c (funcall_general, Ffuncall): Delegate the actual work in Ffuncall to funcall_general which does exactly this. This slows down some less used function call paths by a small amount but the code duplication was just silly. diff --git a/src/eval.c b/src/eval.c index 910777e23d..7c03006732 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3030,6 +3030,7 @@ Lisp_Object funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) { Lisp_Object original_fun = fun; + retry: if (SYMBOLP (fun) && !NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) fun = indirect_function (fun); @@ -3055,7 +3056,8 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) else if (EQ (funcar, Qautoload)) { Fautoload_do_load (fun, original_fun, Qnil); - return funcall_general (original_fun, numargs, args); + fun = original_fun; + goto retry; } else xsignal1 (Qinvalid_function, original_fun); @@ -3069,10 +3071,6 @@ Thus, (funcall \\='cons \\='x \\='y) returns (x . y). usage: (funcall FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object fun, original_fun; - Lisp_Object funcar; - ptrdiff_t numargs = nargs - 1; - Lisp_Object val; ptrdiff_t count; maybe_quit (); @@ -3092,42 +3090,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (debug_on_next_call) do_debug_on_call (Qlambda, count); - original_fun = args[0]; - - retry: - - /* Optimize for no indirection. */ - fun = original_fun; - if (SYMBOLP (fun) && !NILP (fun) - && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) - fun = indirect_function (fun); + Lisp_Object val = funcall_general (args[0], nargs - 1, args + 1); - if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) - val = funcall_subr (XSUBR (fun), numargs, args + 1); - else if (COMPILEDP (fun) - || SUBR_NATIVE_COMPILED_DYNP (fun) - || MODULE_FUNCTIONP (fun)) - val = funcall_lambda (fun, numargs, args + 1); - else - { - if (NILP (fun)) - xsignal1 (Qvoid_function, original_fun); - if (!CONSP (fun)) - xsignal1 (Qinvalid_function, original_fun); - funcar = XCAR (fun); - if (!SYMBOLP (funcar)) - xsignal1 (Qinvalid_function, original_fun); - if (EQ (funcar, Qlambda) - || EQ (funcar, Qclosure)) - val = funcall_lambda (fun, numargs, args + 1); - else if (EQ (funcar, Qautoload)) - { - Fautoload_do_load (fun, original_fun, Qnil); - goto retry; - } - else - xsignal1 (Qinvalid_function, original_fun); - } lisp_eval_depth--; if (backtrace_debug_on_exit (specpdl + count)) val = call_debugger (list2 (Qexit, val)); commit 75c6564c928e6548ec10b938db9693dda3dd09e5 Author: Mattias Engdegård Date: Sun Jan 2 16:11:45 2022 +0100 ; * lisp/emacs-lisp/byte-opt.el: Remove outdated comments These were optimisation ideas that have been implemented, have become irrelevant, or were impractical to begin with. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index a0c6dd99a9..25898285fa 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -37,125 +37,11 @@ ;; TO DO: ;; -;; (apply (lambda (x &rest y) ...) 1 (foo)) -;; -;; maintain a list of functions known not to access any global variables -;; (actually, give them a 'dynamically-safe property) and then -;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==> -;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> ) -;; by recursing on this, we might be able to eliminate the entire let. -;; However certain variables should never have their bindings optimized -;; away, because they affect everything. -;; (put 'debug-on-error 'binding-is-magic t) -;; (put 'debug-on-abort 'binding-is-magic t) -;; (put 'debug-on-next-call 'binding-is-magic t) -;; (put 'inhibit-quit 'binding-is-magic t) -;; (put 'quit-flag 'binding-is-magic t) -;; (put 't 'binding-is-magic t) -;; (put 'nil 'binding-is-magic t) -;; possibly also -;; (put 'gc-cons-threshold 'binding-is-magic t) -;; (put 'track-mouse 'binding-is-magic t) -;; others? -;; -;; Simple defsubsts often produce forms like -;; (let ((v1 (f1)) (v2 (f2)) ...) -;; (FN v1 v2 ...)) -;; It would be nice if we could optimize this to -;; (FN (f1) (f2) ...) -;; but we can't unless FN is dynamically-safe (it might be dynamically -;; referring to the bindings that the lambda arglist established.) -;; One of the uncountable lossages introduced by dynamic scope... -;; -;; Maybe there should be a control-structure that says "turn on -;; fast-and-loose type-assumptive optimizations here." Then when -;; we see a form like (car foo) we can from then on assume that -;; the variable foo is of type cons, and optimize based on that. -;; But, this won't win much because of (you guessed it) dynamic -;; scope. Anything down the stack could change the value. -;; (Another reason it doesn't work is that it is perfectly valid -;; to call car with a null argument.) A better approach might -;; be to allow type-specification of the form -;; (put 'foo 'arg-types '(float (list integer) dynamic)) -;; (put 'foo 'result-type 'bool) -;; It should be possible to have these types checked to a certain -;; degree. -;; -;; collapse common subexpressions -;; -;; It would be nice if redundant sequences could be factored out as well, -;; when they are known to have no side-effects: -;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2 -;; but beware of traps like -;; (cons (list x y) (list x y)) -;; -;; Tail-recursion elimination is not really possible in Emacs Lisp. -;; Tail-recursion elimination is almost always impossible when all variables -;; have dynamic scope, but given that the "return" byteop requires the -;; binding stack to be empty (rather than emptying it itself), there can be -;; no truly tail-recursive Emacs Lisp functions that take any arguments or -;; make any bindings. -;; -;; Here is an example of an Emacs Lisp function which could safely be -;; byte-compiled tail-recursively: -;; -;; (defun tail-map (fn list) -;; (cond (list -;; (funcall fn (car list)) -;; (tail-map fn (cdr list))))) -;; -;; However, if there was even a single let-binding around the COND, -;; it could not be byte-compiled, because there would be an "unbind" -;; byte-op between the final "call" and "return." Adding a -;; Bunbind_all byteop would fix this. -;; -;; (defun foo (x y z) ... (foo a b c)) -;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return) -;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return) -;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return) -;; -;; this also can be considered tail recursion: -;; -;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return) -;; could generalize this by doing the optimization -;; (goto X) ... X: (return) --> (return) -;; -;; But this doesn't solve all of the problems: although by doing tail- -;; recursion elimination in this way, the call-stack does not grow, the -;; binding-stack would grow with each recursive step, and would eventually -;; overflow. I don't believe there is any way around this without lexical -;; scope. -;; -;; Wouldn't it be nice if Emacs Lisp had lexical scope. -;; -;; Idea: the form (lexical-scope) in a file means that the file may be -;; compiled lexically. This proclamation is file-local. Then, within -;; that file, "let" would establish lexical bindings, and "let-dynamic" -;; would do things the old way. (Or we could use CL "declare" forms.) -;; We'd have to notice defvars and defconsts, since those variables should -;; always be dynamic, and attempting to do a lexical binding of them -;; should simply do a dynamic binding instead. -;; But! We need to know about variables that were not necessarily defvared -;; in the file being compiled (doing a boundp check isn't good enough.) -;; Fdefvar() would have to be modified to add something to the plist. -;; -;; A major disadvantage of this scheme is that the interpreter and compiler -;; would have different semantics for files compiled with (dynamic-scope). -;; Since this would be a file-local optimization, there would be no way to -;; modify the interpreter to obey this (unless the loader was hacked -;; in some grody way, but that's a really bad idea.) - -;; Other things to consider: - -;; ;; Associative math should recognize subcalls to identical function: -;; (disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2)))) -;; ;; This should generate the same as (1+ x) and (1- x) - -;; (disassemble (lambda (x) (cons (+ x 1) (- x 1)))) ;; ;; An awful lot of functions always return a non-nil value. If they're ;; ;; error free also they may act as true-constants. - +;; ;; (disassemble (lambda (x) (and (point) (foo)))) + ;; ;; When ;; ;; - all but one arguments to a function are constant ;; ;; - the non-constant argument is an if-expression (cond-expression?) commit 11e1abd5cc76c9adc72746c25688cf23365a9eb0 Author: Mattias Engdegård Date: Sun Jan 2 12:19:54 2022 +0100 Open-code aref and aset in bytecode interpreter * src/bytecode.c (exec_byte_code): Inline aref and aset for vectors and records, since this is important for code that makes heavy use of arrays and/or objects. diff --git a/src/bytecode.c b/src/bytecode.c index b2e8f4a916..76ef2fb661 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -948,15 +948,39 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Baref): { - Lisp_Object v1 = POP; - TOP = Faref (TOP, v1); + Lisp_Object idxval = POP; + Lisp_Object arrayval = TOP; + ptrdiff_t size; + ptrdiff_t idx; + if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true)) + || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))) + && FIXNUMP (idxval) + && (idx = XFIXNUM (idxval), + idx >= 0 && idx < size)) + TOP = AREF (arrayval, idx); + else + TOP = Faref (arrayval, idxval); NEXT; } CASE (Baset): { - Lisp_Object v2 = POP, v1 = POP; - TOP = Faset (TOP, v1, v2); + Lisp_Object newelt = POP; + Lisp_Object idxval = POP; + Lisp_Object arrayval = TOP; + ptrdiff_t size; + ptrdiff_t idx; + if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true)) + || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))) + && FIXNUMP (idxval) + && (idx = XFIXNUM (idxval), + idx >= 0 && idx < size)) + { + ASET (arrayval, idx, newelt); + TOP = newelt; + } + else + TOP = Faset (arrayval, idxval, newelt); NEXT; } commit 721357b86856505324b5f32584d5eae0ba9ab4ac Author: Mattias Engdegård Date: Sun Jan 2 11:35:16 2022 +0100 Remove the unused unbind-all bytecode It was implemented but never generated, originally intended for TCO in the pre-lexbind era (which was semantically dubious anyway). Removing it speeds up the interpreter because there is no longer any need for the outermost `count` variable unless checking is enabled. * lisp/emacs-lisp/bytecomp.el: * lisp/emacs-lisp/comp.el (comp-limplify-lap-inst): * src/bytecode.c (BYTE_CODES, exec_byte_code): Remove definition and implementation of unbind-all, freeing up the opcode for other purposes. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a34ba37c04..2f4bf66343 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -796,11 +796,7 @@ the unwind-action") (byte-defop 144 0 byte-temp-output-buffer-setup-OBSOLETE) (byte-defop 145 -1 byte-temp-output-buffer-show-OBSOLETE) -;; these ops are new to v19 - -;; To unbind back to the beginning of this frame. -;; Not used yet, but will be needed for tail-recursion elimination. -(byte-defop 146 0 byte-unbind-all) +;; unused: 146 ;; these ops are new to v19 (byte-defop 147 -2 byte-set-marker) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 74b0b1197b..3c61063a3c 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1943,7 +1943,6 @@ and the annotation emission." (byte-condition-case) ;; Obsolete (byte-temp-output-buffer-setup-OBSOLETE) (byte-temp-output-buffer-show-OBSOLETE) - (byte-unbind-all) ;; Obsolete (byte-set-marker auto) (byte-match-beginning auto) (byte-match-end auto) diff --git a/src/bytecode.c b/src/bytecode.c index 75f1a6b43e..b2e8f4a916 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -227,7 +227,7 @@ DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \ DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ \ -DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \ +/* 0222 was Bunbind_all, never used. */ \ \ DEFINE (Bset_marker, 0223) \ DEFINE (Bmatch_beginning, 0224) \ @@ -703,12 +703,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, unbind_to (SPECPDL_INDEX () - op, Qnil); NEXT; - CASE (Bunbind_all): /* Obsolete. Never used. */ - /* To unbind back to the beginning of this frame. Not used yet, - but will be needed for tail-recursion elimination. */ - unbind_to (count, Qnil); - NEXT; - CASE (Bgoto): op = FETCH2; op_branch: commit 4ff1fb8eb475a540c094878db1811797e2ca2368 Author: Mattias Engdegård Date: Sun Jan 2 11:15:41 2022 +0100 Move a runtime interpreter check to debug mode * src/bytecode.c (exec_byte_code): Perform bytecode unwinding error check only when building with debugging (NDEBUG not defined, checking enabled, or BYTE_CODE_SAFE enabled). This improves speed in several ways. diff --git a/src/bytecode.c b/src/bytecode.c index 8e0f3d3e4b..75f1a6b43e 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1564,15 +1564,17 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, exit: - eassert (SDATA (bytestr) == bytestr_data); - - /* Binds and unbinds are supposed to be compiled balanced. */ +#if BYTE_CODE_SAFE || !defined NDEBUG if (SPECPDL_INDEX () != count) { + /* Binds and unbinds are supposed to be compiled balanced. */ if (SPECPDL_INDEX () > count) unbind_to (count, Qnil); error ("binding stack not balanced (serious byte compiler bug)"); } +#endif + /* The byte code should have been properly pinned. */ + eassert (SDATA (bytestr) == bytestr_data); Lisp_Object result = TOP; SAFE_FREE (); commit b3377e67a7b20a9a53aa2129b2c3951be67ad102 Author: Mattias Engdegård Date: Sat Jan 1 22:39:17 2022 +0100 Remove nil check in exec_byte_code Since we pass no arguments to a non-lexbind bytecode function, we can specify its arity as 0 instead of nil and save a test and branch. * src/bytecode.c (Fbyte_code, exec_byte_code): * src/eval.c (fetch_and_exec_byte_code, funcall_lambda): * src/lisp.h: Change the args_template parameter type to ptrdiff_t, since it is now always a small integer, in exec_byte_code and fetch_and_exec_byte_code, all callers adjusted. diff --git a/src/bytecode.c b/src/bytecode.c index 7a9966e20e..8e0f3d3e4b 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -333,7 +333,7 @@ If the third argument is incorrect, Emacs may crash. */) } pin_string (bytestr); // Bytecode must be immovable. - return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); + return exec_byte_code (bytestr, vector, maxdepth, 0, 0, NULL); } static void @@ -344,15 +344,14 @@ bcall0 (Lisp_Object f) /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, - emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp - argument list (including &rest, &optional, etc.), and ARGS, of size - NARGS, should be a vector of the actual arguments. The arguments in - ARGS are pushed on the stack according to ARGS_TEMPLATE before - executing BYTESTR. */ + emacs may crash!). ARGS_TEMPLATE is the function arity encoded as an + integer, and ARGS, of size NARGS, should be a vector of the actual + arguments. The arguments in ARGS are pushed on the stack according + to ARGS_TEMPLATE before executing BYTESTR. */ Lisp_Object exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, - Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args) + ptrdiff_t args_template, ptrdiff_t nargs, Lisp_Object *args) { #ifdef BYTE_CODE_METER int volatile this_op = 0; @@ -384,26 +383,25 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, unsigned char const *pc = bytestr_data; ptrdiff_t count = SPECPDL_INDEX (); - if (!NILP (args_template)) - { - eassert (FIXNUMP (args_template)); - ptrdiff_t at = XFIXNUM (args_template); - bool rest = (at & 128) != 0; - int mandatory = at & 127; - ptrdiff_t nonrest = at >> 8; - if (! (mandatory <= nargs && (rest || nargs <= nonrest))) - Fsignal (Qwrong_number_of_arguments, - list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), - make_fixnum (nargs))); - ptrdiff_t pushedargs = min (nonrest, nargs); - for (ptrdiff_t i = 0; i < pushedargs; i++, args++) - PUSH (*args); - if (nonrest < nargs) - PUSH (Flist (nargs - nonrest, args)); - else - for (ptrdiff_t i = nargs - rest; i < nonrest; i++) - PUSH (Qnil); - } + /* ARGS_TEMPLATE is composed of bit fields: + bits 0..6 minimum number of arguments + bits 7 1 iff &rest argument present + bits 8..14 maximum number of arguments */ + bool rest = (args_template & 128) != 0; + int mandatory = args_template & 127; + ptrdiff_t nonrest = args_template >> 8; + if (! (mandatory <= nargs && (rest || nargs <= nonrest))) + Fsignal (Qwrong_number_of_arguments, + list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), + make_fixnum (nargs))); + ptrdiff_t pushedargs = min (nonrest, nargs); + for (ptrdiff_t i = 0; i < pushedargs; i++, args++) + PUSH (*args); + if (nonrest < nargs) + PUSH (Flist (nargs - nonrest, args)); + else + for (ptrdiff_t i = nargs - rest; i < nonrest; i++) + PUSH (Qnil); while (true) { @@ -671,7 +669,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, val = exec_byte_code (bytecode, AREF (fun, COMPILED_CONSTANTS), AREF (fun, COMPILED_STACK_DEPTH), - template, numargs, args); + XFIXNUM (template), numargs, args); else if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) val = funcall_subr (XSUBR (fun), numargs, args); else diff --git a/src/eval.c b/src/eval.c index 8912e28525..910777e23d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3222,15 +3222,16 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) bytecode string and constants vector, fetch them from the file first. */ static Lisp_Object -fetch_and_exec_byte_code (Lisp_Object fun, Lisp_Object syms_left, +fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, ptrdiff_t nargs, Lisp_Object *args) { if (CONSP (AREF (fun, COMPILED_BYTECODE))) Ffetch_bytecode (fun); + return exec_byte_code (AREF (fun, COMPILED_BYTECODE), AREF (fun, COMPILED_CONSTANTS), AREF (fun, COMPILED_STACK_DEPTH), - syms_left, nargs, args); + args_template, nargs, args); } static Lisp_Object @@ -3308,7 +3309,8 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, argument-binding code below instead (as do all interpreted functions, even lexically bound ones). */ { - return fetch_and_exec_byte_code (fun, syms_left, nargs, arg_vector); + return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), + nargs, arg_vector); } lexenv = Qnil; } @@ -3394,7 +3396,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, val = XSUBR (fun)->function.a0 (); } else - val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL); + val = fetch_and_exec_byte_code (fun, 0, 0, NULL); return unbind_to (count, val); } diff --git a/src/lisp.h b/src/lisp.h index fdcb7f39d5..54e8c30ccf 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4700,7 +4700,7 @@ extern int read_bytecode_char (bool); /* Defined in bytecode.c. */ extern void syms_of_bytecode (void); extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, ptrdiff_t, Lisp_Object *); + ptrdiff_t, ptrdiff_t, Lisp_Object *); extern Lisp_Object get_byte_code_arity (Lisp_Object); /* Defined in macros.c. */ commit d05f387407858672ff0d10b963dbdeaf2a9163e0 Author: Mattias Engdegård Date: Sat Jan 1 15:33:27 2022 +0100 ; * src/bytecode.c (exec_byte_code): Cosmetic improvement Implement point_max in the same way as point_min. diff --git a/src/bytecode.c b/src/bytecode.c index 00db29b014..7a9966e20e 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1212,12 +1212,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bpoint_max): - { - Lisp_Object v1; - XSETFASTINT (v1, ZV); - PUSH (v1); - NEXT; - } + PUSH (make_fixed_natnum (ZV)); + NEXT; CASE (Bpoint_min): PUSH (make_fixed_natnum (BEGV)); commit 7392f2dc4102fcc5bc4e8a9752db589f75ab9f52 Author: Mattias Engdegård Date: Fri Dec 31 19:44:02 2021 +0100 Byte code arity check micro-optimisation * src/bytecode.c (exec_byte_code): Slight simplification. diff --git a/src/bytecode.c b/src/bytecode.c index 0d0a28cd0b..00db29b014 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -391,8 +391,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, bool rest = (at & 128) != 0; int mandatory = at & 127; ptrdiff_t nonrest = at >> 8; - ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest; - if (! (mandatory <= nargs && nargs <= maxargs)) + if (! (mandatory <= nargs && (rest || nargs <= nonrest))) Fsignal (Qwrong_number_of_arguments, list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), make_fixnum (nargs))); commit 65caf5b205d22f76bb4ec85cfe597b621a83afb3 Author: Mattias Engdegård Date: Fri Dec 31 17:24:31 2021 +0100 Pin bytecode strings to avoid copy at call time Avoid making a copy (in the interpreter C stack frame) of the bytecode string by making sure it won't be moved by the GC. This is done by reallocating it to the heap normally only used for large strings, which isn't compacted. This requires that we retain an explicit reference to the bytecode string object (`bytestr`) lest it be GCed away should all other references vanish during execution. We allocate an extra stack slot for that, as we already do for the constant vector object. * src/alloc.c (allocate_string_data): Add `immovable` argument. (resize_string_data, make_clear_multibyte_string): Use it. (pin_string): New. * src/pdumper.c (dump_string): Fix incorrect comment. Update hash for Lisp_String (only comments changed, not contents). * src/lread.c (read1): * src/alloc.c (Fmake_byte_code, purecopy): * src/bytecode.c (Fbyte_code): Pin bytecode on object creation. (exec_byte_code): Don't copy bytecode. Retain `bytestr` explicitly. * src/lisp.h (Lisp_String): Explain special size_byte values. (string_immovable_p): New. diff --git a/src/alloc.c b/src/alloc.c index e0b2c22023..e01ea36e64 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1853,7 +1853,8 @@ allocate_string (void) static void allocate_string_data (struct Lisp_String *s, - EMACS_INT nchars, EMACS_INT nbytes, bool clearit) + EMACS_INT nchars, EMACS_INT nbytes, bool clearit, + bool immovable) { sdata *data; struct sblock *b; @@ -1867,7 +1868,7 @@ allocate_string_data (struct Lisp_String *s, MALLOC_BLOCK_INPUT; - if (nbytes > LARGE_STRING_BYTES) + if (nbytes > LARGE_STRING_BYTES || immovable) { size_t size = FLEXSIZEOF (struct sblock, data, needed); @@ -1967,7 +1968,7 @@ resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte, } else { - allocate_string_data (XSTRING (string), nchars, new_nbytes, false); + allocate_string_data (XSTRING (string), nchars, new_nbytes, false, false); unsigned char *new_data = SDATA (string); new_charaddr = new_data + cidx_byte; memcpy (new_charaddr + new_clen, data + cidx_byte + clen, @@ -2483,7 +2484,7 @@ make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit) s = allocate_string (); s->u.s.intervals = NULL; - allocate_string_data (s, nchars, nbytes, clearit); + allocate_string_data (s, nchars, nbytes, clearit, false); XSETSTRING (string, s); string_chars_consed += nbytes; return string; @@ -2513,6 +2514,29 @@ make_formatted_string (char *buf, const char *format, ...) return make_string (buf, length); } +/* Pin a unibyte string in place so that it won't move during GC. */ +void +pin_string (Lisp_Object string) +{ + eassert (STRINGP (string) && !STRING_MULTIBYTE (string)); + struct Lisp_String *s = XSTRING (string); + ptrdiff_t size = STRING_BYTES (s); + unsigned char *data = s->u.s.data; + + if (!(size > LARGE_STRING_BYTES + || PURE_P (data) || pdumper_object_p (data) + || s->u.s.size_byte == -3)) + { + eassert (s->u.s.size_byte == -1); + sdata *old_sdata = SDATA_OF_STRING (s); + allocate_string_data (s, size, size, false, true); + memcpy (s->u.s.data, data, size); + old_sdata->string = NULL; + SDATA_NBYTES (old_sdata) = size; + } + s->u.s.size_byte = -3; +} + /*********************************************************************** Float Allocation @@ -3515,6 +3539,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT && FIXNATP (args[COMPILED_STACK_DEPTH]))) error ("Invalid byte-code object"); + pin_string (args[COMPILED_BYTECODE]); // Bytecode must be immovable. + /* We used to purecopy everything here, if purify-flag was set. This worked OK for Emacs-23, but with Emacs-24's lexical binding code, it can be dangerous, since make-byte-code is used during execution to build @@ -5653,6 +5679,10 @@ purecopy (Lisp_Object obj) memcpy (vec, objp, nbytes); for (i = 0; i < size; i++) vec->contents[i] = purecopy (vec->contents[i]); + // Byte code strings must be pinned. + if (COMPILEDP (obj) && size >= 2 && STRINGP (vec->contents[1]) + && !STRING_MULTIBYTE (vec->contents[1])) + pin_string (vec->contents[1]); XSETVECTOR (obj, vec); } else if (BARE_SYMBOL_P (obj)) diff --git a/src/bytecode.c b/src/bytecode.c index 37da0858ab..0d0a28cd0b 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -331,6 +331,7 @@ If the third argument is incorrect, Emacs may crash. */) the original unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); } + pin_string (bytestr); // Bytecode must be immovable. return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); } @@ -358,22 +359,28 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #endif eassert (!STRING_MULTIBYTE (bytestr)); + eassert (string_immovable_p (bytestr)); ptrdiff_t const_length = ASIZE (vector); ptrdiff_t bytestr_length = SCHARS (bytestr); Lisp_Object *vectorp = XVECTOR (vector)->contents; unsigned char quitcounter = 1; - EMACS_INT stack_items = XFIXNAT (maxdepth) + 1; + /* Allocate two more slots than required, because... */ + EMACS_INT stack_items = XFIXNAT (maxdepth) + 2; USE_SAFE_ALLOCA; void *alloc; - SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); + SAFE_ALLOCA_LISP (alloc, stack_items); Lisp_Object *stack_base = alloc; - Lisp_Object *top = stack_base; - *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ - Lisp_Object *stack_lim = stack_base + stack_items; - unsigned char const *bytestr_data = memcpy (stack_lim, - SDATA (bytestr), bytestr_length); + /* ... we plonk BYTESTR and VECTOR there to ensure that they survive + GC (bug#33014), since these variables aren't used directly beyond + the interpreter prologue and wouldn't be found in the stack frame + otherwise. */ + stack_base[0] = bytestr; + stack_base[1] = vector; + Lisp_Object *top = stack_base + 1; + Lisp_Object *stack_lim = top + stack_items; + unsigned char const *bytestr_data = SDATA (bytestr); unsigned char const *pc = bytestr_data; ptrdiff_t count = SPECPDL_INDEX (); @@ -1564,6 +1571,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, exit: + eassert (SDATA (bytestr) == bytestr_data); + /* Binds and unbinds are supposed to be compiled balanced. */ if (SPECPDL_INDEX () != count) { diff --git a/src/lisp.h b/src/lisp.h index 020fe6e094..fdcb7f39d5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1554,7 +1554,9 @@ struct Lisp_String struct { ptrdiff_t size; /* MSB is used as the markbit. */ - ptrdiff_t size_byte; /* Set to -1 for unibyte strings. */ + ptrdiff_t size_byte; /* Set to -1 for unibyte strings, + -2 for data in rodata, + -3 for immovable unibyte strings. */ INTERVAL intervals; /* Text properties in this string. */ unsigned char *data; } s; @@ -1702,6 +1704,13 @@ CHECK_STRING_NULL_BYTES (Lisp_Object string) Qfilenamep, string); } +/* True if STR is immovable (whose data won't move during GC). */ +INLINE bool +string_immovable_p (Lisp_Object str) +{ + return XSTRING (str)->u.s.size_byte == -3; +} + /* A regular vector is just a header plus an array of Lisp_Objects. */ struct Lisp_Vector @@ -4048,6 +4057,7 @@ extern Lisp_Object make_specified_string (const char *, ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t); +extern void pin_string (Lisp_Object string); /* Make a string allocated in pure space, use STR as string data. */ diff --git a/src/lread.c b/src/lread.c index 4ec1df672c..9910db27de 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3237,16 +3237,20 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms) && FIXNATP (AREF (tmp, COMPILED_STACK_DEPTH)))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRINGP (AREF (tmp, COMPILED_BYTECODE)) - && STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE))) + if (STRINGP (AREF (tmp, COMPILED_BYTECODE))) { - /* BYTESTR must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and - now such a byte-code string is loaded as multibyte with - raw 8-bit characters converted to multibyte form. - Convert them back to the original unibyte form. */ - ASET (tmp, COMPILED_BYTECODE, - Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE))); + if (STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE))) + { + /* BYTESTR must have been produced by Emacs 20.2 or earlier + because it produced a raw 8-bit string for byte-code and + now such a byte-code string is loaded as multibyte with + raw 8-bit characters converted to multibyte form. + Convert them back to the original unibyte form. */ + ASET (tmp, COMPILED_BYTECODE, + Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE))); + } + // Bytecode must be immovable. + pin_string (AREF (tmp, COMPILED_BYTECODE)); } XSETPVECTYPE (vec, PVEC_COMPILED); diff --git a/src/pdumper.c b/src/pdumper.c index eeebb7ed0e..60280fcb04 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2068,7 +2068,7 @@ dump_interval_tree (struct dump_context *ctx, static dump_off dump_string (struct dump_context *ctx, const struct Lisp_String *string) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_String_348C2B2FDB) +#if CHECK_STRUCTS && !defined (HASH_Lisp_String_C2CAF90352) # error "Lisp_String changed. See CHECK_STRUCTS comment in config.h." #endif /* If we have text properties, write them _after_ the string so that @@ -2079,7 +2079,7 @@ dump_string (struct dump_context *ctx, const struct Lisp_String *string) we seldom write to string data and never relocate it, so lumping it together at the end of the dump saves on COW faults. - If, however, the string's size_byte field is -1, the string data + If, however, the string's size_byte field is -2, the string data is actually a pointer to Emacs data segment, so we can do even better by emitting a relocation instead of bothering to copy the string data. */ commit ce1de3a8d9723305f48fd4527fbceaff3cec50ba Author: Mattias Engdegård Date: Fri Dec 31 16:47:56 2021 +0100 Inline setcar and setcdr in byte-code interpreter The function call overhead is nontrivial in comparison to the actual code which makes this worthwhile. * src/bytecode.c (exec_byte_code): Inline code from Fsetcar and Fsetcdr. diff --git a/src/bytecode.c b/src/bytecode.c index c5c86ba8f0..37da0858ab 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -26,6 +26,7 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "syntax.h" #include "window.h" +#include "puresize.h" /* Work around GCC bug 54561. */ #if GNUC_PREREQ (4, 3, 0) @@ -1409,15 +1410,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bsetcar): { - Lisp_Object v1 = POP; - TOP = Fsetcar (TOP, v1); + Lisp_Object newval = POP; + Lisp_Object cell = TOP; + CHECK_CONS (cell); + CHECK_IMPURE (cell, XCONS (cell)); + XSETCAR (cell, newval); + TOP = newval; NEXT; } CASE (Bsetcdr): { - Lisp_Object v1 = POP; - TOP = Fsetcdr (TOP, v1); + Lisp_Object newval = POP; + Lisp_Object cell = TOP; + CHECK_CONS (cell); + CHECK_IMPURE (cell, XCONS (cell)); + XSETCDR (cell, newval); + TOP = newval; NEXT; } commit 6c000af611419745cc7f6c5ea1df1ed961cd6ec3 Author: Mattias Engdegård Date: Thu Dec 30 18:48:53 2021 +0100 Inline fixnum operations in bytecode interpreter Since numeric operations are mostly done on fixnums, this gives a speed-up for common code. * src/bytecode.c (exec_byte_code): Inline fixnum comparisons and operations with fixnum results: =, >, <, <=, >=, -, +, -, *, /, %, max and min. diff --git a/src/bytecode.c b/src/bytecode.c index 2be558d747..c5c86ba8f0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1032,43 +1032,72 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Beqlsign): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = EQ (v1, v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_EQUAL); NEXT; } CASE (Bgtr): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_GRTR); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) > XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_GRTR); NEXT; } CASE (Blss): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_LESS); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) < XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_LESS); NEXT; } CASE (Bleq): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) <= XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_LESS_OR_EQUAL); NEXT; } CASE (Bgeq): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) >= XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_GRTR_OR_EQUAL); NEXT; } CASE (Bdiff): - DISCARD (1); - TOP = Fminus (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && (res = XFIXNUM (v1) - XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fminus (2, &TOP); + NEXT; + } CASE (Bnegate): TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM @@ -1077,34 +1106,83 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bplus): - DISCARD (1); - TOP = Fplus (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && (res = XFIXNUM (v1) + XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fplus (2, &TOP); + NEXT; + } CASE (Bmax): - DISCARD (1); - TOP = Fmax (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + { + if (XFIXNUM (v2) > XFIXNUM (v1)) + TOP = v2; + } + else + TOP = Fmax (2, &TOP); + NEXT; + } CASE (Bmin): - DISCARD (1); - TOP = Fmin (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + { + if (XFIXNUM (v2) < XFIXNUM (v1)) + TOP = v2; + } + else + TOP = Fmin (2, &TOP); + NEXT; + } CASE (Bmult): - DISCARD (1); - TOP = Ftimes (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + intmax_t res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && !INT_MULTIPLY_WRAPV (XFIXNUM (v1), XFIXNUM (v2), &res) + && !FIXNUM_OVERFLOW_P (res)) + TOP = make_fixnum (res); + else + TOP = Ftimes (2, &TOP); + NEXT; + } CASE (Bquo): - DISCARD (1); - TOP = Fquo (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0 + && (res = XFIXNUM (v1) / XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fquo (2, &TOP); + NEXT; + } CASE (Brem): { - Lisp_Object v1 = POP; - TOP = Frem (TOP, v1); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0) + TOP = make_fixnum (XFIXNUM (v1) % XFIXNUM (v2)); + else + TOP = Frem (v1, v2); NEXT; } commit 15961108c9acbef5b7e7daeb47f026969b7a5407 Author: Mattias Engdegård Date: Tue Dec 28 16:50:07 2021 +0100 Short-circuit the recursive bytecode funcall chain Inline parts of the code for function calls to speed up the common case of calling lexbound byte-code. By eliminating intermediate functions, this also reduces C stack usage a little. * src/bytecode.c (exec_byte_code): Inline parts of Ffuncall, funcall_lambda and fetch_and_exec_byte_code in the Bcall opcode handler. * src/eval.c (backtrace_debug_on_exit): Inline and move to lisp.h. (do_debug_on_call): Make global so that it can be called from bytecode.c. (funcall_general): New function, essentially the meat of Ffuncall. * src/lisp.h (backtrace_debug_on_exit): Moved here from eval.c. diff --git a/src/bytecode.c b/src/bytecode.c index b7e65d05ae..2be558d747 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -629,7 +629,53 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } } #endif - TOP = Ffuncall (op + 1, &TOP); + maybe_quit (); + + if (++lisp_eval_depth > max_lisp_eval_depth) + { + if (max_lisp_eval_depth < 100) + max_lisp_eval_depth = 100; + if (lisp_eval_depth > max_lisp_eval_depth) + error ("Lisp nesting exceeds `max-lisp-eval-depth'"); + } + + ptrdiff_t numargs = op; + Lisp_Object fun = TOP; + Lisp_Object *args = &TOP + 1; + + ptrdiff_t count1 = record_in_backtrace (fun, args, numargs); + maybe_gc (); + if (debug_on_next_call) + do_debug_on_call (Qlambda, count1); + + Lisp_Object original_fun = fun; + if (SYMBOLP (fun)) + fun = XSYMBOL (fun)->u.s.function; + Lisp_Object template; + Lisp_Object bytecode; + Lisp_Object val; + if (COMPILEDP (fun) + // Lexical binding only. + && (template = AREF (fun, COMPILED_ARGLIST), + FIXNUMP (template)) + // No autoloads. + && (bytecode = AREF (fun, COMPILED_BYTECODE), + !CONSP (bytecode))) + val = exec_byte_code (bytecode, + AREF (fun, COMPILED_CONSTANTS), + AREF (fun, COMPILED_STACK_DEPTH), + template, numargs, args); + else if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) + val = funcall_subr (XSUBR (fun), numargs, args); + else + val = funcall_general (original_fun, numargs, args); + + lisp_eval_depth--; + if (backtrace_debug_on_exit (specpdl + count1)) + val = call_debugger (list2 (Qexit, val)); + specpdl_ptr--; + + TOP = val; NEXT; } diff --git a/src/eval.c b/src/eval.c index 6a8c759c1d..8912e28525 100644 --- a/src/eval.c +++ b/src/eval.c @@ -138,13 +138,6 @@ backtrace_args (union specbinding *pdl) return pdl->bt.args; } -static bool -backtrace_debug_on_exit (union specbinding *pdl) -{ - eassert (pdl->kind == SPECPDL_BACKTRACE); - return pdl->bt.debug_on_exit; -} - /* Functions to modify slots of backtrace records. */ static void @@ -354,7 +347,7 @@ call_debugger (Lisp_Object arg) return unbind_to (count, val); } -static void +void do_debug_on_call (Lisp_Object code, ptrdiff_t count) { debug_on_next_call = 0; @@ -3033,6 +3026,42 @@ FUNCTIONP (Lisp_Object object) return false; } +Lisp_Object +funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) +{ + Lisp_Object original_fun = fun; + if (SYMBOLP (fun) && !NILP (fun) + && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) + fun = indirect_function (fun); + + if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) + return funcall_subr (XSUBR (fun), numargs, args); + else if (COMPILEDP (fun) + || SUBR_NATIVE_COMPILED_DYNP (fun) + || MODULE_FUNCTIONP (fun)) + return funcall_lambda (fun, numargs, args); + else + { + if (NILP (fun)) + xsignal1 (Qvoid_function, original_fun); + if (!CONSP (fun)) + xsignal1 (Qinvalid_function, original_fun); + Lisp_Object funcar = XCAR (fun); + if (!SYMBOLP (funcar)) + xsignal1 (Qinvalid_function, original_fun); + if (EQ (funcar, Qlambda) + || EQ (funcar, Qclosure)) + return funcall_lambda (fun, numargs, args); + else if (EQ (funcar, Qautoload)) + { + Fautoload_do_load (fun, original_fun, Qnil); + return funcall_general (original_fun, numargs, args); + } + else + xsignal1 (Qinvalid_function, original_fun); + } +} + DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, doc: /* Call first argument as a function, passing remaining arguments to it. Return the value that function returns. diff --git a/src/lisp.h b/src/lisp.h index 97ed084ce8..020fe6e094 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3343,6 +3343,13 @@ SPECPDL_INDEX (void) return specpdl_ptr - specpdl; } +INLINE bool +backtrace_debug_on_exit (union specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->bt.debug_on_exit; +} + /* This structure helps implement the `catch/throw' and `condition-case/signal' control structures. A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. @@ -4338,6 +4345,9 @@ extern void mark_specpdl (union specbinding *first, union specbinding *ptr); extern void get_backtrace (Lisp_Object array); Lisp_Object backtrace_top_function (void); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); +void do_debug_on_call (Lisp_Object code, ptrdiff_t count); +Lisp_Object funcall_general (Lisp_Object fun, + ptrdiff_t numargs, Lisp_Object *args); /* Defined in unexmacosx.c. */ #if defined DARWIN_OS && defined HAVE_UNEXEC commit c34d06e3d75bfbea2605e3ae292850175ce5c235 (refs/remotes/origin/emacs-28) Author: Philipp Stephani Date: Mon Jan 24 11:35:07 2022 +0100 * configure.ac (LIBSECCOMP): Bump minimum version for faccessat2. diff --git a/configure.ac b/configure.ac index 0f79a64a66..9e8519dc3c 100644 --- a/configure.ac +++ b/configure.ac @@ -4375,7 +4375,7 @@ AC_CHECK_HEADERS( ]])]) AC_SUBST([HAVE_SECCOMP]) -EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0]) +EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.5.2]) AC_SUBST([HAVE_LIBSECCOMP]) AC_SUBST([LIBSECCOMP_LIBS]) AC_SUBST([LIBSECCOMP_CFLAGS]) commit 335a5a9e0f956d466305c73b6257a6caaefa3533 Author: Lars Ingebrigtsen Date: Mon Jan 24 11:22:49 2022 +0100 Make the `f' command work in image-mode again * lisp/image.el (image-show-frame): Protect against not having computed the animation data yed (bug#53489). diff --git a/lisp/image.el b/lisp/image.el index af30353b95..ea1a22698c 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -872,8 +872,9 @@ Frames are indexed from 0. Optional argument NOCHECK non-nil means do not check N is within the range of frames present in the image." (unless nocheck (if (< n 0) (setq n 0) - (setq n (min n (1- (car (plist-get (cdr image) - :animate-multi-frame-data))))))) + (setq n (min n (1- (car (or (plist-get (cdr image) + :animate-multi-frame-data) + (image-multi-frame-p image)))))))) (plist-put (cdr image) :index n) (force-window-update (plist-get (cdr image) :animate-buffer))) commit bcf844b5fcaeff3548e35b6a6e3c320c8187ae06 Author: Lars Ingebrigtsen Date: Mon Jan 24 11:16:30 2022 +0100 Add "then" to sh--completion-keywords * lisp/progmodes/sh-script.el (sh--completion-keywords): Allow completing over "then" (bug#53490). diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index ba86ceb0ed..3ad0f0182f 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1602,7 +1602,7 @@ This adds rules for comments and assignments." ;;; Completion -(defvar sh--completion-keywords '("if" "while" "until" "for")) +(defvar sh--completion-keywords '("if" "while" "until" "for" "then")) (defun sh--vars-before-point () (save-excursion commit 842ea1e22f2251e62a23c3fafdd7d1571f730d7d Author: Lars Ingebrigtsen Date: Mon Jan 24 11:09:40 2022 +0100 Fix Gnus registry key bindings * lisp/gnus/gnus-registry.el (gnus-registry-install-shortcuts): Don't overwrite all other M M commands (bug#53492). diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index edeacbc919..ccdaabe3c6 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -954,13 +954,12 @@ FUNCTION should take two parameters, a mark symbol and the cell value." (defun gnus-registry-install-shortcuts () "Install the keyboard shortcuts and menus for the registry. Uses `gnus-registry-marks' to find what shortcuts to install." - (let (keys-plist) - (setq gnus-registry-misc-menus nil) - (gnus-registry-do-marks - :char - (lambda (mark data) - (let ((function-format - (format "gnus-registry-%%s-article-%s-mark" mark))) + (setq gnus-registry-misc-menus nil) + (gnus-registry-do-marks + :char + (lambda (mark data) + (let ((function-format + (format "gnus-registry-%%s-article-%s-mark" mark))) ;;; The following generates these functions: ;;; (defun gnus-registry-set-article-Important-mark (&rest articles) @@ -972,39 +971,37 @@ Uses `gnus-registry-marks' to find what shortcuts to install." ;;; (interactive (gnus-summary-work-articles current-prefix-arg)) ;;; (gnus-registry-set-article-mark-internal 'Important articles t t)) - (dolist (remove '(t nil)) - (let* ((variant-name (if remove "remove" "set")) - (function-name - (intern (format function-format variant-name))) - (shortcut (format "%c" (if remove (upcase data) data)))) - (defalias function-name - (lambda (&rest articles) - (:documentation - (format - "%s the %s mark over process-marked ARTICLES." - (upcase-initials variant-name) - mark)) - (interactive - (gnus-summary-work-articles current-prefix-arg)) - (gnus-registry--set/remove-mark mark remove articles))) - (push function-name keys-plist) - (push shortcut keys-plist) - (push (vector (format "%s %s" - (upcase-initials variant-name) - (symbol-name mark)) - function-name t) - gnus-registry-misc-menus) - (gnus-message 9 "Defined mark handling function %s" - function-name)))))) - (define-key gnus-summary-mark-map "M" - (apply #'define-keymap :prefix 'gnus-summary-mark-map - keys-plist)) - (add-hook 'gnus-summary-menu-hook - (lambda () - (easy-menu-add-item - gnus-summary-misc-menu - nil - (cons "Registry Marks" gnus-registry-misc-menus)))))) + (dolist (remove '(t nil)) + (let* ((variant-name (if remove "remove" "set")) + (function-name + (intern (format function-format variant-name))) + (shortcut (format "%c" (if remove (upcase data) data)))) + (defalias function-name + (lambda (&rest articles) + (:documentation + (format + "%s the %s mark over process-marked ARTICLES." + (upcase-initials variant-name) + mark)) + (interactive + (gnus-summary-work-articles current-prefix-arg)) + (gnus-registry--set/remove-mark mark remove articles))) + (keymap-set gnus-summary-mark-map + (concat "M " shortcut) + function-name) + (push (vector (format "%s %s" + (upcase-initials variant-name) + (symbol-name mark)) + function-name t) + gnus-registry-misc-menus) + (gnus-message 9 "Defined mark handling function %s" + function-name)))))) + (add-hook 'gnus-summary-menu-hook + (lambda () + (easy-menu-add-item + gnus-summary-misc-menu + nil + (cons "Registry Marks" gnus-registry-misc-menus))))) (define-obsolete-function-alias 'gnus-registry-user-format-function-M #'gnus-registry-article-marks-to-chars "24.1") commit 2dec6f59ecd4a2e5803c1854bec21235fadbc5f9 Author: Martin Rudalics Date: Mon Jan 24 10:43:56 2022 +0100 ; * src/xfns.c (xic_preedit_draw_callback): Init text_length to quieten gcc. diff --git a/src/xfns.c b/src/xfns.c index 92aed2d46a..33d8d98e70 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -3072,7 +3072,7 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data, { struct frame *f = x_xic_to_frame (xic); struct x_output *output; - ptrdiff_t text_length; + ptrdiff_t text_length = 0; ptrdiff_t charpos; ptrdiff_t original_size; char *text; commit 1575afe8df522a49184217632b2eb4f3d234942c Author: Martin Rudalics Date: Mon Jan 24 10:33:15 2022 +0100 Orderly inhibit frame resizing when activating tool or tab bar (Bug#52986) * src/xdisp.c (redisplay_tab_bar, redisplay_tool_bar): If we do not display a tool or tab bar in these functions, still set f->tool/tab_bar_redisplayed and f->tool/tab_bar_resized. This avoids that when one of these are initially turned off, a later activation resizes the frame despite of the fact that 'frame-inhibit-implied-resize' should prevent it (Bug#52986). diff --git a/src/xdisp.c b/src/xdisp.c index af46d4da60..9c0764be69 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -13928,6 +13928,8 @@ redisplay_tab_bar (struct frame *f) struct it it; struct glyph_row *row; + f->tab_bar_redisplayed = true; + /* If frame hasn't a tab-bar window or if it is zero-height, don't do anything. This means you must start with tab-bar-lines non-zero to get the auto-sizing effect. Or in other words, you @@ -13935,9 +13937,16 @@ redisplay_tab_bar (struct frame *f) if (!WINDOWP (f->tab_bar_window) || (w = XWINDOW (f->tab_bar_window), WINDOW_TOTAL_LINES (w) == 0)) - return false; + { + /* Even if we do not display a tab bar initially, still pretend + that we have resized it. This avoids that a later activation + of the tab bar resizes the frame, despite of the fact that the + setting of 'frame-inhibit-implied-resize' should inhibit it + (Bug#52986). */ + f->tab_bar_resized = true; - f->tab_bar_redisplayed = true; + return false; + } /* Set up an iterator for the tab-bar window. */ init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TAB_BAR_FACE_ID); @@ -14847,6 +14856,8 @@ redisplay_tool_bar (struct frame *f) struct it it; struct glyph_row *row; + f->tool_bar_redisplayed = true; + /* If frame hasn't a tool-bar window or if it is zero-height, don't do anything. This means you must start with tool-bar-lines non-zero to get the auto-sizing effect. Or in other words, you @@ -14854,9 +14865,16 @@ redisplay_tool_bar (struct frame *f) if (!WINDOWP (f->tool_bar_window) || (w = XWINDOW (f->tool_bar_window), WINDOW_TOTAL_LINES (w) == 0)) - return false; + { + /* Even if we do not display a tool bar initially, still pretend + that we have resized it already. This avoids that a later + activation of the tool bar resizes the frame, despite of the + fact that a setting of 'frame-inhibit-implied-resize' should + inhibit it (Bug#52986). */ + f->tool_bar_resized = true; - f->tool_bar_redisplayed = true; + return false; + } /* Set up an iterator for the tool-bar window. */ init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TOOL_BAR_FACE_ID); commit dee029e19ff1874e7483ccd3e5994bda6e3c7e5d Author: Po Lu Date: Mon Jan 24 16:22:54 2022 +0800 * src/xterm.c (x_composite_image): Use the display's picture format. diff --git a/src/xterm.c b/src/xterm.c index 6ca270ec06..bf611db6bc 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3488,14 +3488,15 @@ x_composite_image (struct glyph_string *s, Pixmap dest, { Display *display = FRAME_X_DISPLAY (s->f); #ifdef HAVE_XRENDER - if (s->img->picture) + if (s->img->picture && FRAME_X_PICTURE_FORMAT (s->f)) { Picture destination; XRenderPictFormat *default_format; XRenderPictureAttributes attr; + /* Pacify GCC. */ + memset (&attr, 0, sizeof attr); - default_format = XRenderFindVisualFormat (display, - DefaultVisual (display, 0)); + default_format = FRAME_X_PICTURE_FORMAT (s->f); destination = XRenderCreatePicture (display, dest, default_format, 0, &attr);