commit 8253228d55b368ad7ea4d66d802059e8afff2b12 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Tue Jun 4 11:00:32 2024 -0400 (hack-dir-local-get-variables-functions): New hook Make it possible to provide more dir-local variables, such as done by the Editorconfig package. * lisp/files.el (hack-dir-local--get-variables): Make arg optional. (hack-dir-local-get-variables-functions): New hook. (hack-dir-local-variables): Run it instead of calling `hack-dir-local--get-variables`. * doc/lispref/variables.texi (Directory Local Variables): Document the new hook. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index e05d3bb0f81..0ed1936cd84 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2277,6 +2277,35 @@ modification times of the associated directory local variables file updates this list. @end defvar +@defvar hack-dir-local-get-variables-functions +This special hook holds the functions that gather the directory-local +variables to use for a given buffer. By default it contains just the +function that obeys the other settings described in the present section. +But it can be used to add support for more sources of directory-local +variables, such as those used by other text editors. + +The functions on this hook are called with no argument, in the buffer to +which we intend to apply the directory-local variables, after the +buffer's major mode function has been run, so they can use sources of +information such as @code{major-mode} or @code{buffer-file-name} to find +the variables that should be applied. + +It should return either a cons cell of the form @code{(@var{directory} +. @var{alist})} or a list of such cons-cells. A @code{nil} return value +means that it found no directory-local variables. @var{directory} +should be a string: the name of the directory to which the variables +apply. @var{alist} is a list of variables together with their values +that apply to the current buffer, where every element is of the form +@code{(@var{varname} . @var{value})}. + +The various @var{alist} returned by these functions will be combined, +and in case of conflicts, the settings coming from deeper directories +will take precedence over those coming from higher directories in the +directory hierarchy. Finally, since this hook is run every time we visit +a file it is important to try and keep those functions efficient, which +will usually require some kind of caching. +@end defvar + @defvar enable-dir-local-variables If @code{nil}, directory-local variables are ignored. This variable may be useful for modes that want to ignore directory-locals while diff --git a/etc/NEWS b/etc/NEWS index 779ff99d442..88da60df591 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2186,6 +2186,11 @@ completion candidate. * Lisp Changes in Emacs 30.1 ++++ +** New hook 'hack-dir-local-get-variables-functions'. +This can be used to provide support for other directory-local settings +beside '.dir-locals.el'. + +++ ** 'auto-coding-functions' can know the name of the file. The functions on this hook can now find the name of the file to diff --git a/lisp/files.el b/lisp/files.el index 210cd0fa7ad..042b8e2d515 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3494,6 +3494,8 @@ we don't actually set it to the same mode the buffer already has." ;; Check for auto-mode-alist entry in dir-locals. (with-demoted-errors "Directory-local variables error: %s" ;; Note this is a no-op if enable-local-variables is nil. + ;; We don't use `hack-dir-local-get-variables-functions' here, because + ;; modes are specific to Emacs. (let* ((mode-alist (cdr (hack-dir-local--get-variables (lambda (key) (eq key 'auto-mode-alist)))))) (set-auto-mode--apply-alist mode-alist keep-mode-if-same t))) @@ -4769,7 +4771,7 @@ Return the new class name, which is a symbol named DIR." (defvar hack-dir-local-variables--warned-coding nil) -(defun hack-dir-local--get-variables (predicate) +(defun hack-dir-local--get-variables (&optional predicate) "Read per-directory local variables for the current buffer. Return a cons of the form (DIR . ALIST), where DIR is the directory name (maybe nil) and ALIST is an alist of all variables @@ -4799,6 +4801,16 @@ PREDICATE is passed to `dir-locals-collect-variables'." (dir-locals-get-class-variables class) dir-name nil predicate)))))) +(defvar hack-dir-local-get-variables-functions + (list #'hack-dir-local--get-variables) + "Special hook to compute the set of dir-local variables. +Every function is called without arguments and should return either +a cons of the form (DIR . ALIST) or a (possibly empty) list of such conses, +where ALIST is an alist of (VAR . VAL) settings. +DIR should be a string (a directory name) and is used to obey +`safe-local-variable-directories'. +This hook is run after the major mode has been setup.") + (defun hack-dir-local-variables () "Read per-directory local variables for the current buffer. Store the directory-local variables in `dir-local-variables-alist' @@ -4806,21 +4818,54 @@ and `file-local-variables-alist', without applying them. This does nothing if either `enable-local-variables' or `enable-dir-local-variables' are nil." - (let* ((items (hack-dir-local--get-variables nil)) - (dir-name (car items)) - (variables (cdr items))) - (when variables - (dolist (elt variables) - (if (eq (car elt) 'coding) - (unless hack-dir-local-variables--warned-coding - (setq hack-dir-local-variables--warned-coding t) - (display-warning 'files - "Coding cannot be specified by dir-locals")) - (unless (memq (car elt) '(eval mode)) - (setq dir-local-variables-alist - (assq-delete-all (car elt) dir-local-variables-alist))) - (push elt dir-local-variables-alist))) - (hack-local-variables-filter variables dir-name)))) + (let (items) + (when (and enable-local-variables + enable-dir-local-variables + (or enable-remote-dir-locals + (not (file-remote-p (or (buffer-file-name) + default-directory))))) + (run-hook-wrapped 'hack-dir-local-get-variables-functions + (lambda (fun) + (let ((res (funcall fun))) + (cond + ((null res)) + ((consp (car-safe res)) + (setq items (append res items))) + (t (push res items)))) + nil))) + ;; Sort the entries from nearest dir to furthest dir. + (setq items (sort (nreverse items) + :key (lambda (x) (length (car-safe x))) :reverse t)) + ;; Filter out duplicates, preferring the settings from the nearest dir + ;; and from the first hook function. + (let ((seen nil)) + (dolist (item items) + (when seen ;; Special case seen=nil since it's the most common case. + (setcdr item (seq-filter (lambda (vv) (not (memq (car-safe vv) seen))) + (cdr item)))) + (setq seen (nconc (seq-difference (mapcar #'car (cdr item)) + '(eval mode)) + seen)))) + ;; Rather than a loop, maybe we should handle all the dirs + ;; "together", e.g. prompting the user only once. But if so, we'd + ;; probably want to also merge the prompt for file-local vars, + ;; which comes from the call to `hack-local-variables-filter' in + ;; `hack-local-variables'. + (dolist (item items) + (let ((dir-name (car item)) + (variables (cdr item))) + (when variables + (dolist (elt variables) + (if (eq (car elt) 'coding) + (unless hack-dir-local-variables--warned-coding + (setq hack-dir-local-variables--warned-coding t) + (display-warning 'files + "Coding cannot be specified by dir-locals")) + (unless (memq (car elt) '(eval mode)) + (setq dir-local-variables-alist + (assq-delete-all (car elt) dir-local-variables-alist))) + (push elt dir-local-variables-alist))) + (hack-local-variables-filter variables dir-name)))))) (defun hack-dir-local-variables-non-file-buffer () "Apply directory-local variables to a non-file buffer. commit 3ecc6b4f3c2b070ed2c4463e2c5d8755ccc19f1c Author: Stefan Monnier Date: Tue Jun 4 10:58:29 2024 -0400 (find-auto-coding): Provide filename to `auto-coding-functions` Allow `auto-coding-functions` to know the file name. Motivated by the needs of Editorconfig support. * lisp/international/mule.el (auto-coding-file-name): New var. (find-auto-coding): Let-bind it for `auto-coding-functions`. Document the expectation that the arg be an absolute file name. * doc/lispref/nonascii.texi (Default Coding Systems): Mention `auto-coding-file-name`. * test/lisp/international/mule-util-resources/test.utf-16le: New file. * test/lisp/international/mule-tests.el (mule-tests--dir): New var. (mule-tests--auto-coding): New fun. (mule-tests--auto-coding-functions): New test. diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index b33082e2b24..1482becb9f5 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -1654,6 +1654,9 @@ argument, @var{size}, which tells it how many characters to look at, starting from point. If the function succeeds in determining a coding system for the file, it should return that coding system. Otherwise, it should return @code{nil}. +Each function can also find the name of the file to which +the buffer's content belong in the variable +@code{auto-coding-file-name}. The functions in this list could be called either when the file is visited and Emacs wants to decode its contents, and/or when the file's diff --git a/etc/NEWS b/etc/NEWS index a7d17862242..779ff99d442 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2186,6 +2186,11 @@ completion candidate. * Lisp Changes in Emacs 30.1 ++++ +** 'auto-coding-functions' can know the name of the file. +The functions on this hook can now find the name of the file to +which the text belongs by consulting the variable 'auto-coding-file-name'. + +++ ** New user option 'compilation-safety' to control safety of native code. It's now possible to control how safe is the code generated by native diff --git a/lisp/international/mule.el b/lisp/international/mule.el index a17221e6d21..ed74fdae755 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1806,6 +1806,9 @@ or nil." (setq alist (cdr alist))))) coding-system))) +(defvar auto-coding-file-name nil + "Variable holding the name of the file for `auto-coding-functions'.") + ;; See the bottom of this file for built-in auto coding functions. (defcustom auto-coding-functions '(sgml-xml-auto-coding-function sgml-html-meta-auto-coding-function) @@ -1820,6 +1823,9 @@ called both when the file is visited and Emacs wants to decode its contents, and when the file's buffer is about to be saved and Emacs wants to determine how to encode its contents. +The name of the file is provided to the function via the variable +`auto-coding-file-name'. + If one of these functions succeeds in determining a coding system, it should return that coding system. Otherwise, it should return nil. @@ -1847,13 +1853,17 @@ files.") coding-system)) (put 'enable-character-translation 'permanent-local t) -(put 'enable-character-translation 'safe-local-variable 'booleanp) +(put 'enable-character-translation 'safe-local-variable #'booleanp) (defun find-auto-coding (filename size) + ;; FIXME: Shouldn't we use nil rather than "" to mean that there's no file? + ;; FIXME: Clarify what the SOURCE is for in the return value? "Find a coding system for a file FILENAME of which SIZE bytes follow point. These bytes should include at least the first 1k of the file and the last 3k of the file, but the middle may be omitted. +FILENAME should be an absolute file name +or \"\" (which means that there is no associated file). The function checks FILENAME against the variable `auto-coding-alist'. If FILENAME doesn't match any entries in the variable, it checks the contents of the current buffer following point against @@ -1998,7 +2008,8 @@ use \"coding: 'raw-text\" instead." :warning) (setq coding-system (ignore-errors (save-excursion (goto-char (point-min)) - (funcall (pop funcs) size))))) + (let ((auto-coding-file-name filename)) + (funcall (pop funcs) size)))))) (if coding-system (cons coding-system 'auto-coding-functions))))) @@ -2013,7 +2024,7 @@ function by default." (if (and found (coding-system-p (car found))) (car found)))) -(setq set-auto-coding-function 'set-auto-coding) +(setq set-auto-coding-function #'set-auto-coding) (defun after-insert-file-set-coding (inserted &optional visit) "Set `buffer-file-coding-system' of current buffer after text is inserted. diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 9a80ced55ae..9c869cc8e6f 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -25,6 +25,8 @@ (require 'ert-x) ;For `ert-simulate-keys'. +(defconst mule-tests--dir (file-name-directory (macroexp-file-name))) + (ert-deftest find-auto-coding--bug27391 () "Check that Bug#27391 is fixed." (with-temp-buffer @@ -94,6 +96,23 @@ ;; The chinese-hz encoding is not ASCII compatible. (should-not (coding-system-get 'chinese-hz :ascii-compatible-p))) +(defun mule-tests--auto-coding (_size) + (when (and (stringp auto-coding-file-name) + (string-match-p "\\.utf-16le\\'" auto-coding-file-name)) + 'utf-16le-with-signature)) + +(ert-deftest mule-tests--auto-coding-functions () + (unwind-protect + (progn + (add-hook 'auto-coding-functions #'mule-tests--auto-coding) + (with-temp-buffer + (insert-file-contents + (expand-file-name "mule-util-resources/test.utf-16le" + mule-tests--dir)) + (goto-char (point-min)) + (should (search-forward "été" nil t)))) + (remove-hook 'auto-coding-functions #'mule-tests--auto-coding))) + ;;; Testing `sgml-html-meta-auto-coding-function'. (defvar sgml-html-meta-pre "" diff --git a/test/lisp/international/mule-util-resources/test.utf-16le b/test/lisp/international/mule-util-resources/test.utf-16le new file mode 100644 index 00000000000..8536adb5341 Binary files /dev/null and b/test/lisp/international/mule-util-resources/test.utf-16le differ commit ce5d004b5b093842d9c46976c50453015fe1a7e7 Author: Noah Peart Date: Fri Apr 19 01:46:50 2024 -0700 Add typescript-ts-mode indentation for multi-assignment decls * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--indent-rules): Add indentation rules for lexical and variable declarations with multiple assignments. * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts: Add indent test for variable declarations (bug#68054). diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index ab1d76ab20e..ed60819388f 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -91,6 +91,17 @@ Check if a node type is available, then return the right indent rules." `(((match "<" "jsx_text") parent 0) ((parent-is "jsx_text") parent typescript-ts-mode-indent-offset))))) +(defun typescript-ts-mode--anchor-decl (_n parent &rest _) + "Return the position after the declaration keyword before PARENT. + +This anchor allows aligning variable_declarators in variable and lexical +declarations, accounting for the length of keyword (var, let, or const)." + (let* ((declaration (treesit-parent-until + parent (rx (or "variable" "lexical") "_declaration") t)) + (decl (treesit-node-child declaration 0))) + (+ (treesit-node-start declaration) + (- (treesit-node-end decl) (treesit-node-start decl))))) + (defun typescript-ts-mode--indent-rules (language) "Rules used for indentation. Argument LANGUAGE is either `typescript' or `tsx'." @@ -113,7 +124,8 @@ Argument LANGUAGE is either `typescript' or `tsx'." ((parent-is "switch_case") parent-bol typescript-ts-mode-indent-offset) ((parent-is "switch_default") parent-bol typescript-ts-mode-indent-offset) ((parent-is "type_arguments") parent-bol typescript-ts-mode-indent-offset) - ((parent-is "variable_declarator") parent-bol typescript-ts-mode-indent-offset) + ((parent-is ,(rx (or "variable" "lexical") "_" (or "declaration" "declarator"))) + typescript-ts-mode--anchor-decl 1) ((parent-is "arguments") parent-bol typescript-ts-mode-indent-offset) ((parent-is "array") parent-bol typescript-ts-mode-indent-offset) ((parent-is "formal_parameters") parent-bol typescript-ts-mode-indent-offset) diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts index bec96ad82e0..877382953c1 100644 --- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -62,6 +62,37 @@ const foo = (x: string) => { }; =-=-= +Name: Lexical and variable declarations + +=-= +const foo = () => { + let x = 1, + yyyy: { + [k: string | number]: string, + } = { + "foo": "foo", + "bar": "bar", + }; + var obar = 1, + fo: { [x: any]: any } = { + "a": 1, + "b": 2, + }; + const cccc = 1, + bbb = { + "x": 0 + }, + ddddd = 0; + // First decls with value starting on same line + const a = (x: string): string => { + return x + x; + }; + var bbb = { + "x": 0 + }; +}; +=-=-= + Code: (lambda () (setq indent-tabs-mode nil) commit a486782f5ee394a432eebd1dc507ff558a8d7198 Author: Dmitry Gutov Date: Sun Jun 9 05:37:25 2024 +0300 project-list-buffers-ibuffer: Handle the FILES-ONLY argument * lisp/progmodes/project.el (project-list-buffers-ibuffer): Handle the FILES-ONLY argument (bug71290). (project-list-buffers-buffer-menu): Expand docstring. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ab928a35e54..a16ff30395b 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1567,7 +1567,8 @@ ARG, show only buffers that are visiting files." (funcall project-buffers-viewer pr arg))) (defun project-list-buffers-buffer-menu (project &optional files-only) - "Lists buffers of a project in Buffer-menu mode" + "List buffers for PROJECT in Buffer-menu mode. +If FILES-ONLY is non-nil, only show the file-visiting buffers." (let ((buffer-list-function (lambda () (seq-filter @@ -1598,11 +1599,13 @@ ARG, show only buffers that are visiting files." (list-buffers-noselect files-only buffer-list-function))))) (defun project-list-buffers-ibuffer (project &optional files-only) - "Lists buffers of a project with Ibuffer" - ;; TODO files-only + "List buffers for PROJECT using Ibuffer. +If FILES-ONLY is non-nil, only show the file-visiting buffers." (ibuffer t (format "*Ibuffer-%s*" (project-name project)) - `((predicate . (member (current-buffer) - (project-buffers ',project)))))) + `((predicate . (and + (or ,(not files-only) buffer-file-name) + (member (current-buffer) + (project-buffers ',project))))))) (defcustom project-kill-buffer-conditions '(buffer-file-name ; All file-visiting buffers are included. commit c0480e2211ff210ed037a2ac952070305769bafb Author: mikpom Date: Sun Jun 9 05:32:57 2024 +0300 Support Ibuffer in project-list-buffers * lisp/progmodes/project.el (project-buffers-viewer): New option. (project-list-buffers): Dispatch using it. (project-list-buffers-buffer-menu, project-list-buffers-ibuffer): New functions (bug#71290). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 8a8b4fc33d6..ab928a35e54 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1544,6 +1544,16 @@ displayed." (interactive (list (project--read-project-buffer))) (display-buffer-other-frame buffer-or-name)) +(defcustom project-buffers-viewer 'project-list-buffers-buffer-menu + "Function to use in `project-list-buffers' to render the list. + +It should accept two arguments: PROJECT and FILES-ONLY. The latter +means that only file-visiting buffers should be displayed." + :group 'project + :version "30.1" + :type '(radio (function-item project-list-buffers-buffer-menu) + (function-item project-list-buffers-ibuffer))) + ;;;###autoload (defun project-list-buffers (&optional arg) "Display a list of project buffers. @@ -1553,27 +1563,31 @@ By default, all project buffers are listed except those whose names start with a space (which are for internal use). With prefix argument ARG, show only buffers that are visiting files." (interactive "P") - (let* ((pr (project-current t)) - (buffer-list-function - (lambda () - (seq-filter - (lambda (buffer) - (let ((name (buffer-name buffer)) - (file (buffer-file-name buffer))) - (and (or Buffer-menu-show-internal - (not (string= (substring name 0 1) " ")) - file) - (not (eq buffer (current-buffer))) - (or file (not Buffer-menu-files-only))))) - (project-buffers pr))))) + (let ((pr (project-current t))) + (funcall project-buffers-viewer pr arg))) + +(defun project-list-buffers-buffer-menu (project &optional files-only) + "Lists buffers of a project in Buffer-menu mode" + (let ((buffer-list-function + (lambda () + (seq-filter + (lambda (buffer) + (let ((name (buffer-name buffer)) + (file (buffer-file-name buffer))) + (and (or Buffer-menu-show-internal + (not (string= (substring name 0 1) " ")) + file) + (not (eq buffer (current-buffer))) + (or file (not Buffer-menu-files-only))))) + (project-buffers project))))) (display-buffer (if (version< emacs-version "29.0.50") (let ((buf (list-buffers-noselect - arg (with-current-buffer - (get-buffer-create "*Buffer List*") - (setq-local Buffer-menu-show-internal nil) - (let ((Buffer-menu-files-only arg)) - (funcall buffer-list-function)))))) + files-only (with-current-buffer + (get-buffer-create "*Buffer List*") + (setq-local Buffer-menu-show-internal nil) + (let ((Buffer-menu-files-only files-only)) + (funcall buffer-list-function)))))) (with-current-buffer buf (setq-local revert-buffer-function (lambda (&rest _ignored) @@ -1581,7 +1595,14 @@ ARG, show only buffers that are visiting files." (funcall buffer-list-function)) (tabulated-list-print t)))) buf) - (list-buffers-noselect arg buffer-list-function))))) + (list-buffers-noselect files-only buffer-list-function))))) + +(defun project-list-buffers-ibuffer (project &optional files-only) + "Lists buffers of a project with Ibuffer" + ;; TODO files-only + (ibuffer t (format "*Ibuffer-%s*" (project-name project)) + `((predicate . (member (current-buffer) + (project-buffers ',project)))))) (defcustom project-kill-buffer-conditions '(buffer-file-name ; All file-visiting buffers are included. commit f896c5e8cab3d2eaf46dca4bc4c16e3c58c4bfaa Author: Po Lu Date: Sun Jun 9 09:10:57 2024 +0800 ; Fix coding style of last change * src/process.c (read_and_insert_process_output) (read_and_dispose_of_process_output): Fix coding style. diff --git a/src/process.c b/src/process.c index fe4dcc531c2..94aeac4d7da 100644 --- a/src/process.c +++ b/src/process.c @@ -6140,15 +6140,13 @@ read_process_output_error_handler (Lisp_Object error_val) return Qt; } -static void -read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, - ssize_t nbytes, - struct coding_system *coding); +static void read_and_dispose_of_process_output (struct Lisp_Process *, char *, + ssize_t, + struct coding_system *); -static void -read_and_insert_process_output (struct Lisp_Process *p, char *buf, - ssize_t nread, - struct coding_system *process_coding); +static void read_and_insert_process_output (struct Lisp_Process *, char *, + ssize_t, + struct coding_system *); /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. @@ -6346,9 +6344,10 @@ read_process_output_after_insert (struct Lisp_Process *p, Lisp_Object *old_read_ SET_PT_BOTH (opoint, opoint_byte); } -static void read_and_insert_process_output (struct Lisp_Process *p, char *buf, - ssize_t nread, - struct coding_system *process_coding) +static void +read_and_insert_process_output (struct Lisp_Process *p, char *buf, + ssize_t nread, + struct coding_system *process_coding) { if (!nread || NILP (p->buffer) || !BUFFER_LIVE_P (XBUFFER (p->buffer))) return; @@ -6359,10 +6358,11 @@ static void read_and_insert_process_output (struct Lisp_Process *p, char *buf, ptrdiff_t opoint, opoint_byte; read_process_output_before_insert (p, &old_read_only, &old_begv, &old_zv, - &before, &before_byte, &opoint, &opoint_byte); + &before, &before_byte, &opoint, + &opoint_byte); /* Adapted from call_process. */ - if (NILP (BVAR (XBUFFER(p->buffer), enable_multibyte_characters)) + if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)) && ! CODING_MAY_REQUIRE_DECODING (process_coding)) { insert_1_both (buf, nread, nread, 0, 0, 0); commit d4bbffe83d85662f3c168870df6916187f654088 Author: Dmitry Gutov Date: Sun Jun 9 02:58:19 2024 +0300 read-process-output-max: Increase the default value * src/process.c (read-process-output-max): Increase the default value to 65536 (bug#66020). diff --git a/etc/NEWS b/etc/NEWS index efb9b7078b8..a7d17862242 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -505,7 +505,7 @@ This function lets the user execute multiple SQL statements in one go. It is useful, for example, when a Lisp program needs to evaluate an entire SQL file. -+++ +** The default value of 'read-process-output-max' was increased to 65536. * Editing Changes in Emacs 30.1 diff --git a/src/process.c b/src/process.c index fd09bb98c60..fe4dcc531c2 100644 --- a/src/process.c +++ b/src/process.c @@ -8877,7 +8877,7 @@ amounts of data in one go. On GNU/Linux systems, the value should not exceed /proc/sys/fs/pipe-max-size. See pipe(7) manpage for details. */); - read_process_output_max = 4096; + read_process_output_max = 65536; DEFVAR_BOOL ("read-process-output-fast", read_process_output_fast, doc: /* Non-nil to optimize the insertion of process output. commit 8cf6e311b87fabeba70d59647883a86c8c92b86f Author: Dmitry Gutov Date: Sun Jun 9 02:51:47 2024 +0300 Remember the value of read_process_output_max when process is created * src/process.h (Lisp_Process): Add field readmax. * src/process.c (read_process_output): Use it. (create_process): Save the value of read_process_output_max to it when the process is created (bug#66020). Use for pipe size. diff --git a/src/process.c b/src/process.c index 2e8dd758b3c..fd09bb98c60 100644 --- a/src/process.c +++ b/src/process.c @@ -2194,6 +2194,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) outchannel = p->open_fd[WRITE_TO_SUBPROCESS]; } + p->readmax = clip_to_bounds (1, read_process_output_max, INT_MAX); + /* Set up stdout for the child process. */ if (ptychannel >= 0 && p->pty_out) { @@ -2210,11 +2212,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #if defined(F_SETPIPE_SZ) && defined(F_GETPIPE_SZ) /* If they requested larger reads than the default system pipe capacity, try enlarging the capacity to match the request. */ - if (read_process_output_max > fcntl (inchannel, F_GETPIPE_SZ)) - { - int readmax = clip_to_bounds (1, read_process_output_max, INT_MAX); - fcntl (inchannel, F_SETPIPE_SZ, readmax); - } + if (p->readmax > fcntl (inchannel, F_GETPIPE_SZ)) + fcntl (inchannel, F_SETPIPE_SZ, p->readmax); #endif } @@ -6171,7 +6170,7 @@ read_process_output (Lisp_Object proc, int channel) eassert (0 <= channel && channel < FD_SETSIZE); struct coding_system *coding = proc_decode_coding_system[channel]; int carryover = p->decoding_carryover; - ptrdiff_t readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX); + ptrdiff_t readmax = p->readmax; specpdl_ref count = SPECPDL_INDEX (); Lisp_Object odeactivate; char *chars; diff --git a/src/process.h b/src/process.h index 3f56b087084..f497a64c3d1 100644 --- a/src/process.h +++ b/src/process.h @@ -153,6 +153,8 @@ struct Lisp_Process unsigned int adaptive_read_buffering : 2; /* Skip reading this process on next read. */ bool_bf read_output_skip : 1; + /* Maximum number of bytes to read in a single chunk. */ + ptrdiff_t readmax; /* True means kill silently if Emacs is exited. This is the inverse of the `query-on-exit' flag. */ bool_bf kill_without_query : 1; commit bbc18031aff6f22a1f2b63355f18f294fbdeb797 Author: Dmitry Gutov Date: Sun Sep 24 01:19:14 2023 +0300 Go around calling the default process filter (reducing GC churn) Instead of allocating strings and passing them to the filter, pass the char buffer to a C function implementing the same logic. * src/process.c (read_process_output_before_insert) (read_process_output_after_insert): New functions, extracted from internal-default-process-filter. (Finternal_default_process_filter): Use them. (read_and_insert_process_output): New function. Use them. (read_process_output_fast): New variable. (read_process_output): Use it to choose how to insert (bug#66020). * etc/NEWS: Mention the change. diff --git a/etc/NEWS b/etc/NEWS index 2349cc0cacb..efb9b7078b8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -126,6 +126,13 @@ to your init: (advice-add 'completion-at-point :after #'minibuffer-hide-completions) +** The defult process filter was rewritten in native code. +The round-trip through the Lisp function +'internal-default-process-filter' is skipped when the process filter is +the default one. It's reimplemented in native code, reducing GC churn. + +To undo the change, set 'read-process-output-fast' to nil. + * Changes in Emacs 30.1 diff --git a/src/process.c b/src/process.c index d716453631e..2e8dd758b3c 100644 --- a/src/process.c +++ b/src/process.c @@ -6146,6 +6146,11 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, ssize_t nbytes, struct coding_system *coding); +static void +read_and_insert_process_output (struct Lisp_Process *p, char *buf, + ssize_t nread, + struct coding_system *process_coding); + /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. Yield number of decoded characters read, @@ -6261,7 +6266,10 @@ read_process_output (Lisp_Object proc, int channel) friends don't expect current-buffer to be changed from under them. */ record_unwind_current_buffer (); - read_and_dispose_of_process_output (p, chars, nbytes, coding); + if (read_process_output_fast && p->filter == Qinternal_default_process_filter) + read_and_insert_process_output (p, chars, nbytes, coding); + else + read_and_dispose_of_process_output (p, chars, nbytes, coding); /* Handling the process output should not deactivate the mark. */ Vdeactivate_mark = odeactivate; @@ -6270,6 +6278,128 @@ read_process_output (Lisp_Object proc, int channel) return nbytes; } +static void +read_process_output_before_insert (struct Lisp_Process *p, Lisp_Object *old_read_only, + ptrdiff_t *old_begv, ptrdiff_t *old_zv, + ptrdiff_t *before, ptrdiff_t *before_byte, + ptrdiff_t *opoint, ptrdiff_t *opoint_byte) +{ + Fset_buffer (p->buffer); + *opoint = PT; + *opoint_byte = PT_BYTE; + *old_read_only = BVAR (current_buffer, read_only); + *old_begv = BEGV; + *old_zv = ZV; + + bset_read_only (current_buffer, Qnil); + + /* Insert new output into buffer at the current end-of-output + marker, thus preserving logical ordering of input and output. */ + if (XMARKER (p->mark)->buffer) + set_point_from_marker (p->mark); + else + SET_PT_BOTH (ZV, ZV_BYTE); + *before = PT; + *before_byte = PT_BYTE; + + /* If the output marker is outside of the visible region, save + the restriction and widen. */ + if (! (BEGV <= PT && PT <= ZV)) + Fwiden (); +} + +static void +read_process_output_after_insert (struct Lisp_Process *p, Lisp_Object *old_read_only, + ptrdiff_t old_begv, ptrdiff_t old_zv, + ptrdiff_t before, ptrdiff_t before_byte, + ptrdiff_t opoint, ptrdiff_t opoint_byte) +{ + struct buffer *b; + + /* Make sure the process marker's position is valid when the + process buffer is changed in the signal_after_change above. + W3 is known to do that. */ + if (BUFFERP (p->buffer) + && (b = XBUFFER (p->buffer), b != current_buffer)) + set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b)); + else + set_marker_both (p->mark, p->buffer, PT, PT_BYTE); + + update_mode_lines = 23; + + /* Make sure opoint and the old restrictions + float ahead of any new text just as point would. */ + if (opoint >= before) + { + opoint += PT - before; + opoint_byte += PT_BYTE - before_byte; + } + if (old_begv > before) + old_begv += PT - before; + if (old_zv >= before) + old_zv += PT - before; + + /* If the restriction isn't what it should be, set it. */ + if (old_begv != BEGV || old_zv != ZV) + Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv)); + + bset_read_only (current_buffer, *old_read_only); + SET_PT_BOTH (opoint, opoint_byte); +} + +static void read_and_insert_process_output (struct Lisp_Process *p, char *buf, + ssize_t nread, + struct coding_system *process_coding) +{ + if (!nread || NILP (p->buffer) || !BUFFER_LIVE_P (XBUFFER (p->buffer))) + return; + + Lisp_Object old_read_only; + ptrdiff_t old_begv, old_zv; + ptrdiff_t before, before_byte; + ptrdiff_t opoint, opoint_byte; + + read_process_output_before_insert (p, &old_read_only, &old_begv, &old_zv, + &before, &before_byte, &opoint, &opoint_byte); + + /* Adapted from call_process. */ + if (NILP (BVAR (XBUFFER(p->buffer), enable_multibyte_characters)) + && ! CODING_MAY_REQUIRE_DECODING (process_coding)) + { + insert_1_both (buf, nread, nread, 0, 0, 0); + signal_after_change (PT - nread, 0, nread); + } + else + { /* We have to decode the input. */ + Lisp_Object curbuf; + int carryover = 0; + specpdl_ref count1 = SPECPDL_INDEX (); + + XSETBUFFER (curbuf, current_buffer); + /* We cannot allow after-change-functions be run + during decoding, because that might modify the + buffer, while we rely on process_coding.produced to + faithfully reflect inserted text until we + TEMP_SET_PT_BOTH below. */ + specbind (Qinhibit_modification_hooks, Qt); + decode_coding_c_string (process_coding, + (unsigned char *) buf, nread, curbuf); + unbind_to (count1, Qnil); + + TEMP_SET_PT_BOTH (PT + process_coding->produced_char, + PT_BYTE + process_coding->produced); + signal_after_change (PT - process_coding->produced_char, + 0, process_coding->produced_char); + carryover = process_coding->carryover_bytes; + if (carryover > 0) + memcpy (buf, process_coding->carryover, + process_coding->carryover_bytes); + } + + read_process_output_after_insert (p, &old_read_only, old_begv, old_zv, + before, before_byte, opoint, opoint_byte); +} + static void read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, ssize_t nbytes, @@ -6373,7 +6503,6 @@ Otherwise it discards the output. */) (Lisp_Object proc, Lisp_Object text) { struct Lisp_Process *p; - ptrdiff_t opoint; CHECK_PROCESS (proc); p = XPROCESS (proc); @@ -6384,31 +6513,10 @@ Otherwise it discards the output. */) Lisp_Object old_read_only; ptrdiff_t old_begv, old_zv; ptrdiff_t before, before_byte; - ptrdiff_t opoint_byte; - struct buffer *b; - - Fset_buffer (p->buffer); - opoint = PT; - opoint_byte = PT_BYTE; - old_read_only = BVAR (current_buffer, read_only); - old_begv = BEGV; - old_zv = ZV; - - bset_read_only (current_buffer, Qnil); - - /* Insert new output into buffer at the current end-of-output - marker, thus preserving logical ordering of input and output. */ - if (XMARKER (p->mark)->buffer) - set_point_from_marker (p->mark); - else - SET_PT_BOTH (ZV, ZV_BYTE); - before = PT; - before_byte = PT_BYTE; + ptrdiff_t opoint, opoint_byte; - /* If the output marker is outside of the visible region, save - the restriction and widen. */ - if (! (BEGV <= PT && PT <= ZV)) - Fwiden (); + read_process_output_before_insert (p, &old_read_only, &old_begv, &old_zv, + &before, &before_byte, &opoint, &opoint_byte); /* Adjust the multibyteness of TEXT to that of the buffer. */ if (NILP (BVAR (current_buffer, enable_multibyte_characters)) @@ -6421,35 +6529,8 @@ Otherwise it discards the output. */) insert_from_string_before_markers (text, 0, 0, SCHARS (text), SBYTES (text), 0); - /* Make sure the process marker's position is valid when the - process buffer is changed in the signal_after_change above. - W3 is known to do that. */ - if (BUFFERP (p->buffer) - && (b = XBUFFER (p->buffer), b != current_buffer)) - set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b)); - else - set_marker_both (p->mark, p->buffer, PT, PT_BYTE); - - update_mode_lines = 23; - - /* Make sure opoint and the old restrictions - float ahead of any new text just as point would. */ - if (opoint >= before) - { - opoint += PT - before; - opoint_byte += PT_BYTE - before_byte; - } - if (old_begv > before) - old_begv += PT - before; - if (old_zv >= before) - old_zv += PT - before; - - /* If the restriction isn't what it should be, set it. */ - if (old_begv != BEGV || old_zv != ZV) - Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv)); - - bset_read_only (current_buffer, old_read_only); - SET_PT_BOTH (opoint, opoint_byte); + read_process_output_after_insert (p, &old_read_only, old_begv, old_zv, + before, before_byte, opoint, opoint_byte); } return Qnil; } @@ -8799,6 +8880,13 @@ On GNU/Linux systems, the value should not exceed /proc/sys/fs/pipe-max-size. See pipe(7) manpage for details. */); read_process_output_max = 4096; + DEFVAR_BOOL ("read-process-output-fast", read_process_output_fast, + doc: /* Non-nil to optimize the insertion of process output. +We skip calling `internal-default-process-filter' and don't allocate +the Lisp string that would be used as its argument. Only affects the +case of asynchronous process with the default filter. */); + read_process_output_fast = Qt; + DEFVAR_INT ("process-error-pause-time", process_error_pause_time, doc: /* The number of seconds to pause after handling process errors. This isn't used for all process-related errors, but is used when a commit e2527dd9fd376b15d2f59ae440858b442b069577 Author: Dmitry Gutov Date: Sun Jun 9 00:52:26 2024 +0300 url-retrieve-synchronously: Fix timeout when connection hangs * lisp/url/url.el (url-retrieve-synchronously): Set url-asynchronous to t when TIMEOUT is non-nil (bug#71295). diff --git a/lisp/url/url.el b/lisp/url/url.el index dea251b453b..0ac2917b213 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -235,7 +235,8 @@ If INHIBIT-COOKIES is non-nil, refuse to store cookies. If TIMEOUT is passed, it should be a number that says (in seconds) how long to wait for a response before giving up." (url-do-setup) - (let* (url-asynchronous + (let* (;; Ensure we can stop during connection setup (bug#71295). + (url-asynchronous (not (null timeout))) data-buffer (callback (lambda (&rest _args) (setq data-buffer (current-buffer)) commit e9a0256a556622474bcbb015f88d790666db2cc9 Author: Stefan Monnier Date: Sat Jun 8 17:34:30 2024 -0400 (pcase--app-subst-match): Try and fix performance regression (bug#71398) * lisp/emacs-lisp/pcase.el (pcase--app-subst-match): Optimize matches against (quote VAL). * test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-quote-optimization): Add new test case. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 69353daf7d0..5a7f3995311 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -857,13 +857,36 @@ A and B can be one of: (or (keywordp upat) (integerp upat) (stringp upat))) (defun pcase--app-subst-match (match sym fun nsym) + "Refine MATCH knowing that NSYM = (funcall FUN SYM)." (cond ((eq (car-safe match) 'match) - (if (and (eq sym (cadr match)) - (eq 'app (car-safe (cddr match))) - (equal fun (nth 1 (cddr match)))) - (pcase--match nsym (nth 2 (cddr match))) - match)) + (cond + ((not (eq sym (cadr match))) match) + ((and (eq 'app (car-safe (cddr match))) + (equal fun (nth 1 (cddr match)))) + ;; MATCH is (match SYM app FUN UPAT), so we can refine it to refer to + ;; NSYM rather than re-compute (funcall FUN SYM). + (pcase--match nsym (nth 2 (cddr match)))) + ((eq 'quote (car-safe (cddr match))) + ;; MATCH is (match SYM quote VAL), so we can decompose it into + ;; (match NSYM quote (funcall FUN VAL)) plus a check that + ;; the part of VAL not included in (funcall FUN VAL) still + ;; result is SYM matching (quote VAL). (bug#71398) + (condition-case nil + `(and (match ,nsym . ',(funcall fun (nth 3 match))) + ;; FIXME: "the part of VAL not included in (funcall FUN VAL)" + ;; is hard to define for arbitrary FUN. We do it only when + ;; FUN is `c[ad]r', and for the rest we just preserve + ;; the original `match' which is not optimal but safe. + ,(if (and (memq fun '(car cdr car-safe cdr-safe)) + (consp (nth 3 match))) + (let ((otherfun (if (memq fun '(car car-safe)) + #'cdr-safe #'car-safe))) + `(match ,(cadr match) app ,otherfun + ',(funcall otherfun (nth 3 match)))) + match)) + (error match))) + (t match))) ((memq (car-safe match) '(or and)) `(,(car match) ,@(mapcar (lambda (match) diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index 35cf2f93cdc..e777b71920c 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -83,7 +83,14 @@ (should-not (pcase-tests-grep 'FOO (macroexpand '(pcase EXP (`(,_ . ,_) (BAR)) - ('(a b) (FOO))))))) + ('(a b) (FOO)))))) + (let ((exp1 (macroexpand '(pcase EXP + (`(`(,(or 'a1 'b1)) (FOO1))) + ('(c) (FOO2)) + ('(d) (FOO3)))))) + (should (= 1 (with-temp-buffer (prin1 exp1 (current-buffer)) + (goto-char (point-min)) + (count-matches "(FOO3)")))))) (ert-deftest pcase-tests-bug14773 () (let ((f (lambda (x) commit 15f515c7a37f29117ff123821265a760ff0d040d Author: Jim Porter Date: Mon Jun 3 22:06:49 2024 -0700 Improve implementations of some Eshell output filter functions * lisp/eshell/esh-mode.el (eshell-postoutput-scroll-to-bottom): Use 'get-buffer-window-list' for simplicity. (eshell-handle-control-codes): Use 're-search-forward'; this way is much faster. * test/lisp/eshell/esh-mode-tests.el: New file. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index e6f3cb5f6ad..ec1a07b7e2f 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -765,30 +765,25 @@ This function should be in the list `eshell-output-filter-functions'." (current (current-buffer)) (scroll eshell-scroll-to-bottom-on-output)) (unwind-protect - (walk-windows - (lambda (window) - (if (eq (window-buffer window) current) - (progn - (select-window window) - (if (and (< (point) eshell-last-output-end) - (or (eq scroll t) (eq scroll 'all) - ;; Maybe user wants point to jump to end. - (and (eq scroll 'this) - (eq selected window)) - (and (eq scroll 'others) - (not (eq selected window))) - ;; If point was at the end, keep it at end. - (>= (point) eshell-last-output-start))) - (goto-char eshell-last-output-end)) - ;; Optionally scroll so that the text - ;; ends at the bottom of the window. - (if (and eshell-scroll-show-maximum-output - (>= (point) eshell-last-output-end)) - (save-excursion - (goto-char (point-max)) - (recenter -1))) - (select-window selected)))) - nil t) + (dolist (window (get-buffer-window-list current nil t)) + (with-selected-window window + (when (and (< (point) eshell-last-output-end) + (or (eq scroll t) (eq scroll 'all) + ;; Maybe user wants point to jump to end. + (and (eq scroll 'this) + (eq selected window)) + (and (eq scroll 'others) + (not (eq selected window))) + ;; If point was at the end, keep it at end. + (>= (point) eshell-last-output-start))) + (goto-char eshell-last-output-end)) + ;; Optionally scroll so that the text ends at the bottom of + ;; the window. + (when (and eshell-scroll-show-maximum-output + (>= (point) eshell-last-output-end)) + (save-excursion + (goto-char (point-max)) + (recenter -1))))) (set-buffer current)))) (defun eshell-beginning-of-input () @@ -977,27 +972,24 @@ This function could be in the list `eshell-output-filter-functions'." (goto-char eshell-last-output-block-begin) (unless (eolp) (beginning-of-line)) - (while (< (point) eshell-last-output-end) - (let ((char (char-after))) + (while (re-search-forward (rx (any ?\r ?\a ?\C-h)) + eshell-last-output-end t) + (let ((char (char-before))) (cond ((eq char ?\r) - (if (< (1+ (point)) eshell-last-output-end) - (if (memq (char-after (1+ (point))) - '(?\n ?\r)) - (delete-char 1) - (let ((end (1+ (point)))) + (if (< (point) eshell-last-output-end) + (if (memq (char-after (point)) '(?\n ?\r)) + (delete-char -1) + (let ((end (point))) (beginning-of-line) (delete-region (point) end))) - (add-text-properties (point) (1+ (point)) - '(invisible t)) - (forward-char))) + (add-text-properties (1- (point)) (point) + '(invisible t)))) ((eq char ?\a) - (delete-char 1) + (delete-char -1) (beep)) ((eq char ?\C-h) - (delete-region (1- (point)) (1+ (point)))) - (t - (forward-char))))))) + (delete-region (- (point) 2) (point)))))))) (custom-add-option 'eshell-output-filter-functions 'eshell-handle-control-codes) diff --git a/test/lisp/eshell/esh-mode-tests.el b/test/lisp/eshell/esh-mode-tests.el new file mode 100644 index 00000000000..306e11ce445 --- /dev/null +++ b/test/lisp/eshell/esh-mode-tests.el @@ -0,0 +1,62 @@ +;;; esh-mode-tests.el --- esh-mode test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022-2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for Eshell's command invocation. + +;;; Code: + +(require 'ert) +(require 'esh-mode) +(require 'eshell) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +;;; Tests: + +(ert-deftest esh-mode-test/handle-control-codes/carriage-return () + "Test that Eshell handles carriage returns properly." + (with-temp-eshell + (eshell-match-command-output "(format \"hello\r\ngoodbye\")" + "\\`hello\ngoodbye\n") + (eshell-match-command-output "(format \"hello\rgoodbye\")" + "\\`goodbye\n") + (eshell-match-command-output "(format \"hello\r\")" + "\\`hello"))) + +(ert-deftest esh-mode-test/handle-control-codes/bell () + "Test that Eshell handles bells properly." + (cl-letf* ((beep-called nil) + ((symbol-function 'beep) (lambda () (setq beep-called t)))) + (with-temp-eshell + (eshell-match-command-output "(format \"hello\athere\")" + "\\`hellothere\n") + (should beep-called)))) + +(ert-deftest esh-mode-test/handle-control-codes/backspace () + "Test that Eshell handles backspaces properly." + (with-temp-eshell + (eshell-match-command-output (format "(format \"hello%c%cp\")" ?\C-h ?\C-h) + "\\`help\n"))) + +;; esh-mode-tests.el ends here commit 2fac71255f2e216481f956ad318378cdfddb9402 Author: Jim Porter Date: Mon Jun 3 22:01:48 2024 -0700 Be more efficient when buffering output in Eshell This makes the built-in 'eshell/cat' 5-10x faster on large files in my (somewhat limited) tests. In addition, this change periodically redisplays when using the Eshell buffered output so that users can see some progress. * lisp/eshell/esh-io.el (eshell-print-queue-size, eshell-print-queue, eshell-print-queue-count): Make obsolete in favor of... (eshell-buffered-print-size, eshell--buffered-print-queue) (eshell--buffered-print-current-size): ... these. (eshell-buffered-print-redisplay-throttle): New user option. (eshell--buffered-print-next-redisplay): New variable. (eshell-init-print-buffer): Make obsolete. (eshell-flush): Add new REDISPLAY-NOW argument in favor of CLEAR (which only 'eshell-init-print-buffer' should have used). (eshell-buffered-print): Compare queued output length to 'eshell--buffered-print-current-size'. (eshell-with-buffered-print): New macro. * lisp/eshell/esh-var.el (eshell/env): * lisp/eshell/em-dirs.el (eshell/cd): * lisp/eshell/em-hist.el (eshell/history): * lisp/eshell/em-unix.el (eshell/cat): * lisp/eshell/em-ls.el (eshell/ls): Use 'eshell-with-buffered-print'. (flush-func): Remove. (eshell-ls--insert-directory, eshell-do-ls): Remove 'flush-func'. * test/lisp/eshell/em-unix-tests.el (em-unix-test/compile/interactive) (em-unix-test/compile/pipeline, em-unix-test/compile/subcommand): Fix indentation. (em-unix-test/cat/file-output): New test. * etc/NEWS: Announce these improvements. diff --git a/etc/NEWS b/etc/NEWS index d6a8fa7122b..2349cc0cacb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -963,6 +963,13 @@ files and deny read permission for users who are not members of the file's group. See the Info node "(coreutils) File permissions" for more information on this notation. +--- +*** Performance improvements for interactive output in Eshell. +Interactive output in Eshell should now be significantly faster, +especially for built-in commands that can print large amounts of output +(e.g. "cat"). In addition, these commands can now update the display +periodically to show their progress. + +++ *** New special reference type '#'. This special reference type returns a marker at 'POSITION' in diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index a3d1a349540..e70f2cfe196 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -400,13 +400,12 @@ in the minibuffer: (index 0)) (if (= len 0) (error "Directory ring empty")) - (eshell-init-print-buffer) - (while (< index len) - (eshell-buffered-print - (concat (number-to-string index) ": " - (ring-ref eshell-last-dir-ring index) "\n")) - (setq index (1+ index))) - (eshell-flush) + (eshell-with-buffered-print + (while (< index len) + (eshell-buffered-print + (concat (number-to-string index) ": " + (ring-ref eshell-last-dir-ring index) "\n")) + (setq index (1+ index)))) (setq handled t))))) (path (setq path (eshell-expand-multiple-dots path)))) diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 8865cc745a3..9ffddfb611f 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -333,7 +333,6 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (defun eshell/history (&rest args) "List in help buffer the buffer's input history." - (eshell-init-print-buffer) (eshell-eval-using-options "history" args '((?r "read" nil read-history @@ -370,12 +369,12 @@ unless a different file is specified on the command line.") (let* ((index (1- (or length (ring-length eshell-history-ring)))) (ref (- (ring-length eshell-history-ring) index))) ;; We have to build up a list ourselves from the ring vector. - (while (>= index 0) - (eshell-buffered-print - (format "%5d %s\n" ref (eshell-get-history index))) - (setq index (1- index) - ref (1+ ref))))))) - (eshell-flush) + (eshell-with-buffered-print + (while (>= index 0) + (eshell-buffered-print + (format "%5d %s\n" ref (eshell-get-history index))) + (setq index (1- index) + ref (1+ ref)))))))) nil)) (defun eshell-put-history (input &optional ring at-beginning) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 82d4b01393f..8bf2e20d320 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -229,7 +229,6 @@ scope during the evaluation of TEST-SEXP." (defvar dereference-links) (defvar dir-literal) (defvar error-func) -(defvar flush-func) (defvar human-readable) (defvar ignore-pattern) (defvar insert-func) @@ -278,7 +277,6 @@ instead." (require 'em-glob) (let* ((insert-func 'insert) (error-func 'insert) - (flush-func 'ignore) (eshell-error-if-no-glob t) (target ; Expand the shell wildcards if any. (if (and (atom file) @@ -324,10 +322,10 @@ instead." (defsubst eshell/ls (&rest args) "An alias version of `eshell-do-ls'." - (let ((insert-func 'eshell-buffered-print) - (error-func 'eshell-error) - (flush-func 'eshell-flush)) - (apply 'eshell-do-ls args))) + (eshell-with-buffered-print + (let ((insert-func #'eshell-buffered-print) + (error-func #'eshell-error)) + (apply 'eshell-do-ls args)))) (put 'eshell/ls 'eshell-no-numeric-conversions t) (put 'eshell/ls 'eshell-filename-arguments t) @@ -336,7 +334,6 @@ instead." (defun eshell-do-ls (&rest args) "Implementation of \"ls\" in Lisp, passing ARGS." - (funcall flush-func -1) ;; Process the command arguments, and begin listing files. (eshell-eval-using-options "ls" (if eshell-ls-initial-args @@ -422,8 +419,7 @@ Sort entries alphabetically across.") (eshell-file-attributes arg (if numeric-uid-gid 'integer 'string)))) args) - t (expand-file-name default-directory))) - (funcall flush-func))) + t (expand-file-name default-directory))))) (defsubst eshell-ls-printable-size (filesize &optional by-blocksize) "Return a printable FILESIZE." diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 4137c05fa41..e6bd0381a14 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -659,7 +659,6 @@ symlink, then revert to the system's definition of cat." (if eshell-in-pipeline-p (error "Eshell's `cat' does not work in pipelines") (error "Eshell's `cat' cannot display one of the files given")))) - (eshell-init-print-buffer) (eshell-eval-using-options "cat" args '((?h "help" nil nil "show this usage screen") @@ -672,18 +671,18 @@ Concatenate FILE(s), or standard input, to standard output.") (throw 'eshell-external (eshell-external-command "cat" args)))) (let ((curbuf (current-buffer))) - (dolist (file args) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (while (not (eobp)) - (let ((str (buffer-substring - (point) (min (1+ (line-end-position)) - (point-max))))) - (with-current-buffer curbuf - (eshell-buffered-print str))) - (forward-line))))) - (eshell-flush)))) + (eshell-with-buffered-print + (dolist (file args) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (not (eobp)) + (let* ((pos (min (+ (point) eshell-buffered-print-size) + (point-max))) + (str (buffer-substring (point) pos))) + (with-current-buffer curbuf + (eshell-buffered-print str)) + (goto-char pos)))))))))) (put 'eshell/cat 'eshell-no-numeric-conversions t) (put 'eshell/cat 'eshell-filename-arguments t) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 0fe177d4c60..9de9cc4509a 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -112,10 +112,30 @@ other buffers)." (defcustom eshell-print-queue-size 5 "The size of the print queue, for doing buffered printing. -This is basically a speed enhancement, to avoid blocking the Lisp code -from executing while Emacs is redisplaying." +This variable is obsolete. You should use `eshell-buffered-print-size' +instead." :type 'integer :group 'eshell-io) +(make-obsolete-variable 'eshell-print-queue-size + 'eshell-buffered-print-size "30.1") + +(defcustom eshell-buffered-print-size 2048 + "The size of the print queue in characters, for doing buffered printing. +Larger values for this option will generally result in faster execution +by reducing the overhead associated with each print operation, but will +increase the time it takes to see any progress in the output; smaller +values will do the reverse." + :type 'integer + :group 'eshell-io + :version "30.1") + +(defcustom eshell-buffered-print-redisplay-throttle 0.025 + "The minimum time in seconds between redisplays when using buffered printing. +If nil, don't redisplay while printing." + :type '(choice number + (const :tag "Don't redisplay" nil)) + :group 'eshell-io + :version "30.1") (defcustom eshell-virtual-targets '(;; The literal string "/dev/null" is intentional here. It just @@ -460,40 +480,74 @@ INDEX is the handle index to check. If nil, check (equal (caar (aref handles eshell-error-handle)) '(t))) (equal (caar (aref handles index)) '(t))))) +(defvar eshell--buffered-print-queue nil) +(defvar eshell--buffered-print-current-size nil) +(defvar eshell--buffered-print-next-redisplay nil) + (defvar eshell-print-queue nil) +(make-obsolete-variable 'eshell-print-queue + 'eshell--buffered-print-queue "30.1") (defvar eshell-print-queue-count -1) +(make-obsolete-variable 'eshell-print-queue-count + 'eshell--buffered-print-current-size "30.1") (defsubst eshell-print (object) "Output OBJECT to the standard output handle." (eshell-output-object object eshell-output-handle)) -(defun eshell-flush (&optional reset-p) - "Flush out any lines that have been queued for printing. -Must be called before printing begins with -1 as its argument, and -after all printing is over with no argument." - (ignore - (if reset-p - (setq eshell-print-queue nil - eshell-print-queue-count reset-p) - (if eshell-print-queue - (eshell-print eshell-print-queue)) - (eshell-flush 0)))) - (defun eshell-init-print-buffer () "Initialize the buffered printing queue." - (eshell-flush -1)) + (declare (obsolete #'eshell-with-buffered-print "30.1")) + (setq eshell--buffered-print-queue nil + eshell--buffered-print-current-size 0)) + +(defun eshell-flush (&optional redisplay-now) + "Flush out any text that has been queued for printing. +When printing interactively, this will call `redisplay' every +`eshell-buffered-print-redisplay-throttle' seconds so that the user can +see the progress. If REDISPLAY-NOW is non-nil, call `redisplay' for +interactive output even if the throttle would otherwise prevent it." + (ignore + (when eshell--buffered-print-queue + (eshell-print (apply #'concat eshell--buffered-print-queue)) + ;; When printing interactively (see `eshell-with-buffered-print'), + ;; periodically redisplay so the user can see some progress. + (when (and eshell--buffered-print-next-redisplay + (or redisplay-now + (time-less-p eshell--buffered-print-next-redisplay + (current-time)))) + (redisplay) + (setq eshell--buffered-print-next-redisplay + (time-add eshell--buffered-print-next-redisplay + eshell-buffered-print-redisplay-throttle))) + (setq eshell--buffered-print-queue nil + eshell--buffered-print-current-size 0)))) (defun eshell-buffered-print (&rest strings) - "A buffered print -- *for strings only*." - (if (< eshell-print-queue-count 0) - (progn - (eshell-print (apply 'concat strings)) - (setq eshell-print-queue-count 0)) - (if (= eshell-print-queue-count eshell-print-queue-size) - (eshell-flush)) - (setq eshell-print-queue - (concat eshell-print-queue (apply 'concat strings)) - eshell-print-queue-count (1+ eshell-print-queue-count)))) + "A buffered print -- *for strings only*. +When the buffer exceeds `eshell-buffered-print-size' in characters, this +will flush it using `eshell-flush' (which see)." + (setq eshell--buffered-print-queue + (nconc eshell--buffered-print-queue strings)) + (cl-incf eshell--buffered-print-current-size + (apply #'+ (mapcar #'length strings))) + (when (> eshell--buffered-print-current-size eshell-buffered-print-size) + (eshell-flush))) + +(defmacro eshell-with-buffered-print (&rest body) + "Initialize buffered printing for Eshell, and then evaluate BODY. +Within BODY, call `eshell-buffered-print' to perform output." + (declare (indent 0)) + `(let ((eshell--buffered-print-queue nil) + (eshell--buffered-print-current-size 0) + (eshell--buffered-print-next-redisplay + (when (and eshell-buffered-print-redisplay-throttle + (eshell-interactive-output-p)) + (time-add (current-time) + eshell-buffered-print-redisplay-throttle)))) + (unwind-protect + ,@body + (eshell-flush)))) (defsubst eshell-error (object) "Output OBJECT to the standard error handle." diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 02b5c785625..f0270aca92c 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -437,10 +437,9 @@ the values of nil for each." (if args (or (eshell-parse-local-variables args) (eshell-named-command (car args) (cdr args))) - (eshell-init-print-buffer) - (dolist (setting (sort (eshell-environment-variables) 'string-lessp)) - (eshell-buffered-print setting "\n")) - (eshell-flush)))) + (eshell-with-buffered-print + (dolist (setting (sort (eshell-environment-variables) 'string-lessp)) + (eshell-buffered-print setting "\n")))))) (defun eshell-insert-envvar (envvar-name) "Insert ENVVAR-NAME into the current buffer at point." diff --git a/test/lisp/eshell/em-unix-tests.el b/test/lisp/eshell/em-unix-tests.el index a92c7d3f80a..2ee42c81333 100644 --- a/test/lisp/eshell/em-unix-tests.el +++ b/test/lisp/eshell/em-unix-tests.el @@ -26,10 +26,12 @@ (require 'ert) (require 'em-unix) +(eval-and-compile + (defvar this-directory (file-name-directory + (or load-file-name default-directory)))) + (require 'eshell-tests-helpers - (expand-file-name "eshell-tests-helpers" - (file-name-directory (or load-file-name - default-directory)))) + (expand-file-name "eshell-tests-helpers" this-directory)) ;;; Tests: @@ -37,11 +39,11 @@ "Check that `eshell/compile' opens a compilation buffer interactively." (skip-unless (executable-find "echo")) (with-temp-eshell - (eshell-match-command-output "compile echo hello" - "#") - (with-current-buffer "*compilation*" - (forward-line 3) - (should (looking-at "echo hello"))))) + (eshell-match-command-output "compile echo hello" + "#") + (with-current-buffer "*compilation*" + (forward-line 3) + (should (looking-at "echo hello"))))) (ert-deftest em-unix-test/compile/noninteractive () "Check that `eshell/compile' writes to stdout noninteractively." @@ -54,15 +56,26 @@ (skip-unless (and (executable-find "echo") (executable-find "cat"))) (with-temp-eshell - (eshell-match-command-output "compile echo hello | *cat" - "\\`hello\n"))) + (eshell-match-command-output "compile echo hello | *cat" + "\\`hello\n"))) (ert-deftest em-unix-test/compile/subcommand () "Check that `eshell/compile' writes to stdout from a subcommand." (skip-unless (and (executable-find "echo") (executable-find "cat"))) (with-temp-eshell - (eshell-match-command-output "echo ${compile echo hello}" - "\\`hello\n"))) + (eshell-match-command-output "echo ${compile echo hello}" + "\\`hello\n"))) + +(ert-deftest em-unix-test/cat/file-output () + "Check that `eshell/cat' can print a file's contents." + (with-temp-eshell + (let* ((this-file (expand-file-name "em-unix-tests.el" this-directory)) + (contents (save-current-buffer + (find-file this-file) + (buffer-string)))) + (eshell-match-command-output + (format "cat '%s'" (string-replace "'" "''" this-file)) + (concat (regexp-quote contents)))))) ;; em-unix-tests.el ends here commit c69c822c59f315512ac9a921289761907178e337 Author: F. Jason Park Date: Fri Jun 7 17:08:08 2024 -0700 ; Improve erc-format-privmessage documentation * etc/ERC-NEWS: Mention that `erc-format-privmessage' has been removed from the default client's primary code path. Revise various headlines. * lisp/erc/erc.el: Bump Compat version to 29.1.4.5. (erc-format-privmessage): Make appeal for users to contact the mailing list if they need to modify speaker-message formatting. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 1fad62e1999..c541b3e4289 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -100,7 +100,7 @@ one's optionally accessible from the keyboard, just like any other side window. Hit '' over a nick to spawn a "/QUERY" or a "Lastlog" (Occur) session. See 'erc-nickbar-mode' for more. -** New module to keep tabs on query pals who aren't in your channels. +** New 'querypoll' module for tracking non-channel query participants. ERC has gotten a bit pickier about managing participants in query buffers. "Untracked" correspondents no longer appear automatically in membership tables, even if you respond or initiate contact. Instead, @@ -112,7 +112,7 @@ Those familiar with the IRCv3 Monitor extension can think of this as "fallback code" and a temporary placeholder for the real thing. Add 'querypoll' (and 'nickbar') to 'erc-modules' to try it out. -** Option 'erc-timestamp-use-align-to' more versatile. +** Option 'erc-timestamp-use-align-to' made more versatile. While this option has always offered to right-align stamps via the 'display' text property, it's now more effective at doing so when set to a number indicating an offset from the right edge. Users of the @@ -143,7 +143,7 @@ connectivity before attempting to reconnect in earnest. See option 'erc-server-reconnect-function' and new local module 'services-regain' (also experimental) to get started. -** Modules rather than their libraries set major-mode keybindings. +** Module-based keybinding adjustments for major modes. To put it another way, simply loading a built-in module's library no longer modifies 'erc-mode-map'. Instead, modifications occur during module setup. This should not impact most user configs since ERC @@ -162,7 +162,7 @@ asking users who've customized this option to switch to that some other solution, like automatic migration, is justified, please make that known on the bug list. -** Module 'noncommands' deprecated, replaced by 'command-indicator'. +** Module 'command-indicator' revives echoing, replacing 'noncommands'. Command-line echoing has returned to ERC after a near decade-long hiatus. This means you can elect to have ERC leave a trail of (most) slash-command input submitted at the prompt, in a manner resembling @@ -202,13 +202,14 @@ s-expressions, which ERC will continue to honor. Although the default lineup remains functionally equivalent, its members have all been updated accordingly. -** 'erc-track-faces-priority-list' and 'erc-track-faces-normal-list' slimmed. -These options have been purged of certain 'button'-related face -combinations. Originally added in ERC 5.3, these combinations -described the effect of "buttonizing" atop faces added by the 'match' -module, like '(erc-nick-default-face erc-pal-face)'. However, since -at least Emacs 27, 'match' has run before 'button' in -'erc-insert-modify-hook', meaning such permutations aren't possible. +** A slimmed down 'erc-track-faces-priority-list'. +This option, along with 'erc-track-faces-normal-list', has been purged +of certain 'button'-related face combinations. Originally added in +ERC 5.3, these combinations described the effect of "buttonizing" atop +faces added by the 'match' module, like '(erc-nick-default-face +erc-pal-face)'. However, since at least Emacs 27, 'match' has run +before 'button' in 'erc-insert-modify-hook', meaning such permutations +aren't possible. More importantly, users who've customized either of these options should update them with the new default value of the option @@ -244,15 +245,14 @@ wherever it happens to reside instead of forcing it to the bottom of a window, meaning new input appears above the prompt, scrolling existing messages upward to compensate. -** Subtle changes in two fundamental faces. +** Subtle changes for two fundamental faces. Users of the default theme may notice that 'erc-action-face' and -'erc-notice-face' now appear slightly less bold on systems supporting -a weight of 'semi-bold'. This was done to make buttons detectable and -to spare users from resorting to tweaking these faces, or options like -'erc-notice-highlight-type', just to achieve this effect. It's -currently most prominent in "/ME" messages, where 'erc-action-face' -sits beneath 'erc-input-face', as well as 'erc-my-nick-face' in the -speaker portion. +'erc-notice-face' now appear slightly less bold. This improves button +detection and spares users from having to tweak faces (or options, +like 'erc-notice-highlight-type') just to achieve this effect. The +change is currently most noticeable in "/ME" messages, where +'erc-action-face' appears beneath 'erc-input-face' and +'erc-my-nick-face'. ** Fewer nick buttons in QUIT, JOIN, and PART messages. Common messages that show a nickname followed by a "userhost" often @@ -392,7 +392,7 @@ from 't' to the more useful 'erc-prompt', although the property of the same name has been retained and now has a value of 'hidden' when disconnected. -*** Lists of faces in buttonized text are no longer nested. +*** Flattened face lists for buttonized text. Previously, when "buttonizing" a new region, ERC would combine faces by blindly consing the new onto the existing. In theory, this kept a nice record of all modifications to a given region. However, it also @@ -691,7 +691,7 @@ that the killing of buffers done on behalf of the option 'erc-kill-buffer-on-part' has been made more detectable by the flag 'erc-killing-buffer-on-part-p'. -*** Channel-mode handling has become stricter and more predictable. +*** Stricter and more predictable channel-mode handling. ERC has always processed channel modes using "standardized" letters and popular status prefixes. Starting with this release, ERC will begin preferring advertised "CHANMODES" when interpreting letters and @@ -733,6 +733,13 @@ separate "speaker catalog" keyed by contextual symbols, like 'query-privmsg', ERC (and eventually everyone) will more easily be able to influence how inserted messages take shape in buffers. +As a consequence of this transition, the default client no longer +calls `erc-format-privmessage' to format speaker messages. See that +function's doc string for help adapting to the new system, but please +keep in mind that discussions are still ongoing regarding its eventual +public interface. As usual, anyone interested should get involved by +writing to the mailing list. + *** New format templates for inserted CTCP ACTION messages. In 5.5 and earlier, ERC displayed outgoing CTCP ACTION messages in 'erc-input-face' alone (before buttonizing). Incoming ACTION messages @@ -747,7 +754,7 @@ default "language catalog" in favor of an entry from the new internal by toggling a provided compatibility switch. See source code around the function 'erc-send-action' for details. -*** Miscellaneous changes +*** Miscellaneous changes. In 'erc-button-alist', 'Info-goto-node' has been supplanted by plain old 'info', and the "" entry has been removed because it was more or less redundant. In all ERC buffers, the "" key is now diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2deaedae955..025bfbc0a5f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -13,7 +13,7 @@ ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) ;; Version: 5.6-git -;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4")) +;; Package-Requires: ((emacs "27.1") (compat "29.1.4.5")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -6187,7 +6187,15 @@ NUH, and the current `erc-response' object.") (and erc-channel-users (gethash downcased erc-channel-users))) (defun erc-format-privmessage (nick msg privp msgp) - "Format a PRIVMSG in an insertable fashion." + "Format a PRIVMSG in an insertable fashion. + +Note that as of version 5.6, the default client no longer calls this +function. It instead defers to the `format-spec'-based message-catalog +system to handle all message formatting. Anyone needing to influence +such formatting should describe their use case via \\[erc-bug] or +similar. Please do this instead of resorting to things like modifying +formatting templates to remove speaker brackets (because many modules +rely on their presence, and cleaner ways exist)." (let* ((mark-s (if msgp (if privp "*" "<") "-")) (mark-e (if msgp (if privp "*" ">") "-")) (str (format "%s%s%s %s" mark-s nick mark-e msg)) @@ -9681,7 +9689,7 @@ See also `format-spec'." erc-networks-shrink-ids-and-buffer-names erc-networks-rename-surviving-target-buffer) "Invoked whenever a channel-buffer is killed via `kill-buffer'." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :group 'erc-hooks :type 'hook) commit f6bfa1844b53d6ccd24fd02092ae482d481fc5a5 Author: F. Jason Park Date: Wed Jun 5 00:22:28 2024 -0700 Restore deferred date-stamp insertions in ERC * lisp/erc/erc-stamp.el (erc-stamp--recover-on-reconnect): Treat `erc-stamp--deferred-date-stamp' as a permanent-local variable. (erc-stamp--date): Document expected possible values for `fn' slot. (erc-stamp--defer-date-insertion-on-post-modify): Use the function `ignore' to mean a new `erc-timer-hook' member has been requested. Use nil to mean one has already run. Deferred date stamps are new in ERC 5.6 and Emacs 30. (erc-stamp--date-mode): Improve doc string. * test/lisp/erc/erc-scenarios-stamp.el (erc-scenarios-stamp--date-mode/reconnect): New test. diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a9ffdb18ba7..7788f0b2d68 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -203,6 +203,7 @@ from entering them and instead jump over them." (dolist (var '(erc-timestamp-last-inserted erc-timestamp-last-inserted-left erc-timestamp-last-inserted-right + erc-stamp--deferred-date-stamp erc-stamp--date-stamps)) (when-let (existing (alist-get var priors)) (set var existing))))) @@ -668,7 +669,9 @@ value of t means the option's value doesn't require trimming.") :documentation "Time recorded by `erc-insert-timestamp-left-and-right'.") ( str (error "Missing `str' field") :type string :documentation "Stamp rendered by `erc-insert-timestamp-left-and-right'.") - ( fn nil :type (or null function) + ( fn #'ignore :type (or null function) + ;; Use `ignore' as a third state to mean the creation of a bespoke + ;; date-insertion function has been requested but not completed. :documentation "Deferred insertion function created by post-modify hook.") ( marker (make-marker) :type marker :documentation "Insertion marker.")) @@ -701,6 +704,9 @@ Non-nil between insertion-modification and \"done\" (or timer) hook.") (defun erc-stamp--find-insertion-point (p target-time) "Scan buffer backwards from P looking for TARGET-TIME. Return P or, if found, a position less than P." + ;; Continue searching after encountering a message without a + ;; timestamp because date stamps must be unique, and + ;; "Re-establishing connection" messages should have stamps. (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) (qq (erc--get-inserted-msg-beg q)) (ts (get-text-property qq 'erc--ts)) @@ -720,7 +726,7 @@ inserted is a date stamp." Do so when `erc-stamp--deferred-date-stamp' and its `fn' slot are non-nil." (when-let ((data erc-stamp--deferred-date-stamp) - ((null (erc-stamp--date-fn data))) + ((eq (erc-stamp--date-fn data) #'ignore)) (ct (erc-stamp--date-ts data)) (rendered (erc-stamp--date-str data)) (buffer (current-buffer)) @@ -730,7 +736,7 @@ non-nil." (fset symbol (lambda (&rest _) (remove-hook hook-var symbol) - (setf (erc-stamp--date-fn data) #'ignore) + (setf (erc-stamp--date-fn data) nil) (when (buffer-live-p buffer) (with-current-buffer buffer (setq erc-stamp--date-stamps @@ -770,7 +776,21 @@ non-nil." ;; a standalone module to allow completely decoupling from and ;; possibly deprecating `erc-insert-timestamp-left-and-right'. (define-minor-mode erc-stamp--date-mode - "Insert date stamps as standalone messages." + "When enabled, insert date stamps as standalone messages. +Only do so when `erc-insert-timestamp-function' is set to +`erc-insert-timestamp-left-and-right'. On `erc-insert-modify-hook', +hold off on inserting a date stamp immediately because that would force +other members of the hook to rely on heuristics and implementation +details to detect a prepended stamp's presence, not to mention +compromise the integrity of the `erc-parsed' text property. Instead, +tell `erc-insert-post-hook', via `erc-stamp--deferred-date-stamp', to +schedule a date stamp for insertion on the next go around of +`erc-timer-hook', which only runs on server-sent messages. Expect users +to know that non-server-sent messages, such as local informational +messages, won't induce a date stamp's insertion but will instead defer +it until the next arrival, which can include \"PING\"s or messages that +otherwise don't insert anything, such as those skipped on account of +`erc-ignore'." :interactive nil (if erc-stamp--date-mode (progn diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el index 6f2fbc1b7e9..2e836e163bc 100644 --- a/test/lisp/erc/erc-scenarios-stamp.el +++ b/test/lisp/erc/erc-scenarios-stamp.el @@ -180,4 +180,50 @@ (funcall expect 5 "This server is in debug mode"))))) +;; Assert that only one date stamp per day appears in the server +;; buffer when reconnecting. +(ert-deftest erc-scenarios-stamp--date-mode/reconnect () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (erc-server-flood-penalty 0.1) + (erc-stamp--tz t) + (erc-server-auto-reconnect t) + ;; Start close to midnight: 2024-06-02T23:58:11.055Z + (erc-stamp--current-time (if (< emacs-major-version 29) + '(26205 1811 55000 0) + '(1717372691055 . 1000))) + (erc-insert-post-hook (cons (lambda () + (setq erc-stamp--current-time + (time-add erc-stamp--current-time 0.1))) + erc-insert-post-hook)) + (dumb-server (erc-d-run "localhost" t + 'unexpected-disconnect 'unexpected-disconnect)) + ;; Define overriding formatting function for catalog entry + ;; `disconnected' to spoof time progressing past midnight. + (erc-message-english-disconnected + (let ((orig erc-message-english-disconnected)) + (lambda (&rest _) + (setq erc-stamp--current-time + (time-add erc-stamp--current-time 120)) + orig))) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "debug mode"))) + + ;; Ensure date stamps are unique per server buffer. + (with-current-buffer "FooNet" + (funcall expect 10 "[Mon Jun 3 2024]") + (funcall expect -0.1 "[Mon Jun 3 2024]") ; no duplicates + (funcall expect 10 "[00:00]") + (funcall expect -0.1 "[00:00]") + (funcall expect 10 "Welcome to the foonet") + (delete-process erc-server-process)))) + ;;; erc-scenarios-stamp.el ends here commit 772fb960a948b6951f24442b372ce6833887669b Author: Eli Zaretskii Date: Sat Jun 8 20:43:55 2024 +0300 Fix killing indirect buffers under auto-revert-mode * lisp/autorevert.el (auto-revert-mode): Don't add indirect buffers to 'auto-revert-buffer-list'. (auto-revert-notify-rm-watch): Don't disable file notifications when killing an indirect buffer. (Bug#71424) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index a23d536879d..0fdab6ffc9f 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -401,7 +401,8 @@ Use `auto-revert-tail-mode' if you know that the file will only grow without being changed in the part that is already in the buffer." :group 'auto-revert :lighter auto-revert-mode-text (if auto-revert-mode - (when (not (memq (current-buffer) auto-revert-buffer-list)) + (when (and (not (buffer-base-buffer (current-buffer))) + (not (memq (current-buffer) auto-revert-buffer-list))) (push (current-buffer) auto-revert-buffer-list) (add-hook 'kill-buffer-hook @@ -639,7 +640,10 @@ will use an up-to-date value of `auto-revert-interval'." (defun auto-revert-notify-rm-watch () "Disable file notification for current buffer's associated file." - (when-let ((desc auto-revert-notify-watch-descriptor)) + (when-let ((desc + ;; Don't disable notifications if this is an indirect buffer. + (and (null (buffer-base-buffer)) + auto-revert-notify-watch-descriptor))) (setq auto-revert--buffer-by-watch-descriptor (assoc-delete-all desc auto-revert--buffer-by-watch-descriptor)) (ignore-errors commit 4468216f17aca811c02b49d18c5bee4fb9fd6943 Author: Eli Zaretskii Date: Sat Jun 8 16:19:54 2024 +0300 ; * doc/lispref/display.texi (Image Descriptors): Clarify text. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 64c2cab4ba6..d5c96d13e02 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5933,25 +5933,30 @@ parameters is a useful way of saying ``display this image as large as possible, but no larger than the available display area''. @item :scale @var{scale} -This should be a number, where values higher than 1 means to increase -the size, and lower means to decrease the size, by multiplying both -the width and height. For instance, a value of 0.25 will make the -image a quarter size of what it originally was. If the scaling makes -the image larger than specified by @code{:max-width} or -@code{:max-height}, the resulting size will not exceed those two -values. If both @code{:scale} and @code{:height}/@code{:width} are -specified, the height/width will be adjusted by the specified scaling -factor. +This should be a scaling factor for the image, a number. Values higher +than 1 mean to increase the image size, and lower values mean to +decrease the size, by multiplying both the width and height of the image +by the factor. For instance, a value of 0.25 will make the image a +quarter size of what it originally was. If the scaling makes the image +larger than specified by @code{:max-width} or @code{:max-height}, the +resulting size will not exceed those two values. If both @code{:scale} +and @code{:height}/@code{:width} are specified, the height/width will be +adjusted by the specified scaling factor. @vindex image-scaling-factor -Alternatively, the symbol @code{default} may be specified, indicating -that the image should be scaled according as the value of the -@code{image-scaling-factor} variable is the default @code{auto} or a -number, which by default scales the image in proportion to the average -widths (@pxref{Low-Level Font}) of the default faces of frames on which -it happens to be displayed, if such widths should exceed @code{10} -pixels. If no other value is provided, @code{create-image} will specify -this value in image specifications it creates. +The value of @var{scale} can also be the symbol @code{default}, which +means to use the value of @code{image-scaling-factor}. If that value is +a number, it is the scale factor to use; if it is @code{auto} (the +default), it means to compute the scaling factor based on pixel size of +the font used by the frame's default face (@pxref{Low-Level Font}). +Specifically, if the pixel width of the default face's font is greater +than 10, the image is enlarged by the factor computed as the ratio of +the font width to 10; if the font width is 10 pixels or less, the image +is not scaled. For example, if the default font's width is 15, the +image will be scaled by the factor 1.5. + +If @var{scale} is not provided, @code{create-image} scales the image +according to the value of @code{image-scaling-factor}. @item :rotation @var{angle} Specifies a rotation angle in degrees. Only multiples of 90 degrees commit bd50c804eca3c15388d4c2d0ad12040c562bddb0 Author: Eli Zaretskii Date: Sat Jun 8 16:07:24 2024 +0300 Fix 'string-edit' when abort-callback is omitted * lisp/textmodes/string-edit.el (string-edit): Set 'string-edit--abort-callback' even if ABORT-CALLBACK is nil. (Bug#71406) diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el index 03be426ac25..cafed5a1e16 100644 --- a/lisp/textmodes/string-edit.el +++ b/lisp/textmodes/string-edit.el @@ -75,8 +75,7 @@ Also see `read-string-from-buffer'." (setq buffer-undo-list nil) (string-edit-mode) (setq-local string-edit--success-callback success-callback) - (when abort-callback - (setq-local string-edit--abort-callback abort-callback)) + (setq-local string-edit--abort-callback abort-callback) (setq-local header-line-format (substitute-command-keys "Type \\\\[string-edit-done] when you've finished editing or \\[string-edit-abort] to abort")) commit c03cafba390603de653def097fdcf9566d502061 Author: kobarity Date: Sat Sep 16 23:14:45 2023 +0900 Fix Python mode error caused by incorrect indentation * lisp/progmodes/python.el (python-indent--calculate-indentation): Guard against negative indentation. (Bug #65870) * test/lisp/progmodes/python-tests.el (python-indent-badly-indented-block-end): New test. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b5c00385ef3..bb2bf1731b4 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1819,7 +1819,7 @@ possibilities can be narrowed to specific indentation points." (`(:after-block-end . ,start) ;; Subtract one indentation level. (goto-char start) - (- (current-indentation) python-indent-offset)) + (max 0 (- (current-indentation) python-indent-offset))) (`(:at-dedenter-block-start . ,_) ;; List all possible indentation levels from opening blocks. (let ((opening-block-start-points diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index b06547b10ff..07fafde38cf 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -2149,6 +2149,15 @@ def test_re(string): (python-tests-look-at "else:") (should (= (python-indent-calculate-indentation) 4)))) +(ert-deftest python-indent-badly-indented-block-end () + "Test BUG 65870 regression." + (python-tests-with-temp-buffer + " +return +" + (goto-char (point-max)) + (should (= (python-indent-calculate-indentation) 0)))) + ;;; Filling commit d7be9fdbc009ecf314e1ae9166429188b6ddb121 Author: James Thomas Date: Sun Jun 2 05:59:35 2024 +0530 Check for doc-spec-function early, in interactive invocation * lisp/info-look.el (info-lookup-interactive-arguments): Move here. (info-lookup): From here. (Bug#71314) diff --git a/lisp/info-look.el b/lisp/info-look.el index cd59fdf17d7..2baf133c7d3 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -327,8 +327,11 @@ string of `info-lookup-alist'. If optional argument QUERY is non-nil, query for the help mode." (let* ((mode (cond (query (info-lookup-change-mode topic)) - ((info-lookup->mode-value topic (info-lookup-select-mode)) - info-lookup-mode) + ((when-let + ((info (info-lookup->mode-value + topic (info-lookup-select-mode)))) + (info-lookup--expand-info info)) + info-lookup-mode) ((info-lookup-change-mode topic)))) (completions (info-lookup->completions topic mode)) (default (info-lookup-guess-default topic mode)) @@ -404,9 +407,6 @@ If SAME-WINDOW, reuse the current window. If nil, pop to a different window." (or mode (setq mode (info-lookup-select-mode))) (setq mode (info-lookup--item-to-mode item mode)) - (if-let ((info (info-lookup->mode-value topic mode))) - (info-lookup--expand-info info) - (error "No %s help available for `%s'" topic mode)) (let* ((completions (info-lookup->completions topic mode)) (ignore-case (info-lookup->ignore-case topic mode)) (entry (or (assoc (if ignore-case (downcase item) item) completions) commit 579aaa1ec24b0bd139053919cc87b493773248ce Author: Richard Sent Date: Mon May 27 11:32:00 2024 -0400 Make 'clone-indirect-buffer-other-window' use other window Previously, depending on the settings in 'display-buffer-alist', 'clone-indirect-buffer-other-window' would display the cloned buffer in the original window, behaving identically to 'clone-indirect-buffer' with a non-nil display-flag. This behavior was inconsistent with other-window commands which always used another window. Now, 'clone-indirect-buffer-other-window' uses 'switch-to-buffer-other-window'. This means it uses the same logic as other-window commands like 'find-file-other-window' and 'info-other-window'. display-flag was kept for API stability and functional compatibility reasons. * lisp/simple.el: (clone-indirect-buffer-other-window): Use switch-to-buffer-other-window. (Bug#70819) diff --git a/lisp/simple.el b/lisp/simple.el index 68209eadc41..171ef96351f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10683,8 +10683,10 @@ Returns the newly created indirect buffer." (list (if current-prefix-arg (read-buffer "Name of indirect buffer: " (current-buffer))) t))) - (let ((pop-up-windows t)) - (clone-indirect-buffer newname display-flag norecord))) + ;; For compatibility, don't display the buffer if display-flag is nil. + (let ((buffer (clone-indirect-buffer newname nil norecord))) + (when display-flag + (switch-to-buffer-other-window buffer norecord)))) ;;; Handling of Backspace and Delete keys. commit 35e65a84eb070932318d90ce06ae95b02c7c95ba Merge: ed122417b98 53e9caa23ef Author: Eli Zaretskii Date: Sat Jun 8 07:34:20 2024 -0400 Merge from origin/emacs-29 53e9caa23ef ; * doc/emacs/help.texi (Help, Apropos): Improve text and... 00360258cad Fix treesit-parse-string crash (bug#71012) 20af58d3a13 Check for buffer liveness when accessing tree-sitter node... commit 53e9caa23ef0843337afcb5db4e16ef911d2e78d Author: Eli Zaretskii Date: Sat Jun 8 14:10:10 2024 +0300 ; * doc/emacs/help.texi (Help, Apropos): Improve text and indexing. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 1330717b758..e45f70af159 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -45,22 +45,27 @@ window displaying the @samp{*Help*} buffer will be reused instead. @cindex searching documentation efficiently @cindex looking for a subject in documentation If you are looking for a certain feature, but don't know what it is -called or where to look, we recommend three methods. First, try an -apropos command, then try searching the manual index, then look in the +called or where to look, we recommend three methods. First, try +apropos commands, then try searching the manual index, then look in the FAQ and the package keywords, and finally try listing external packages. @table @kbd @item C-h a @var{topics} @key{RET} This searches for commands whose names match the argument -@var{topics}. The argument can be a keyword, a list of keywords, or a -regular expression (@pxref{Regexps}). @xref{Apropos}. +@var{topics}. The argument can be a keyword, a list of keywords +separated by whitespace, or a regular expression (@pxref{Regexps}). +@xref{Apropos}. -@item C-h i d m emacs @key{RET} i @var{topic} @key{RET} +@item C-h d @var{topics} @key{RET} +Similar, but searches the @emph{text} of the documentation strings +rather than the names of commands and functions. + +@item C-h r i @var{topic} @key{RET} This searches for @var{topic} in the indices of the Emacs Info manual, displaying the first match found. Press @kbd{,} to see subsequent matches. You can use a regular expression as @var{topic}. -@item C-h i d m emacs @key{RET} s @var{topic} @key{RET} +@item C-h r s @var{topic} @key{RET} Similar, but searches the @emph{text} of the manual rather than the indices. @@ -357,10 +362,12 @@ are included varies depending on the command used. @section Apropos @cindex apropos +@cindex apropos pattern +@cindex apropos commands, list of keywords The @dfn{apropos} commands answer questions like, ``What are the commands for working with files?'' More precisely, you specify your query as an @dfn{apropos pattern}, which is either a word, a list of -words, or a regular expression. +words separated by whitespace, or a regular expression. Each of the following apropos commands reads an apropos pattern in the minibuffer, searches for items that match the pattern, and commit ed122417b98d711bacf5ed24778886bf21d86956 Author: Po Lu Date: Sat Jun 8 15:17:23 2024 +0800 Improve scaling of tab bar items on high-density displays * lisp/tab-bar.el (tab-bar-auto-width-max) (tab-bar-auto-width-min): Accept values of a new format where the pixel width is a list and is subject to scaling. (tab-bar-auto-width-1): New function. (tab-bar-auto-width): Scale pixel values from t-b-a-w-min and t-b-a-w-max. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index dac57ce2070..6ab6324540e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1168,33 +1168,47 @@ length of the tab's name." :group 'tab-bar :version "29.1") -(defcustom tab-bar-auto-width-max '(220 20) +(defcustom tab-bar-auto-width-max '((220) 20) "Maximum width for automatic resizing of width of tab-bar tabs. This determines the maximum width of tabs before their names will be truncated on display. -The value should be a list of two numbers: the first is the maximum -width of tabs in pixels for GUI frames, the second is the maximum -width of tabs in characters on TTY frames. + +The value should be a list of two values: the first is the maximum width +of tabs in pixels for GUI frames, the second is the maximum width of +tabs in characters on TTY frames. Of these two values both accept +integers, but the first element that provides a width in pixels can +further be a list of a single integer, also specifying an integral width +in pixels, but signifying that it should be scaled by the difference +between the `frame-char-height' of the tab bar's frame, and 15, when the +former height exceeds the latter threshold. + If the value of this variable is nil, there is no limit on maximum width. This variable has effect only when `tab-bar-auto-width' is non-nil." :type '(choice (const :tag "No limit" nil) - (list (integer :tag "Max width (pixels)" :value 220) + (list (choice + (integer :tag "Max width (pixels)" :value 220) + (list (integer :tag "Max width (scaled pixels)" + :value 220))) (integer :tag "Max width (chars)" :value 20))) :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (setq tab-bar--auto-width-hash nil)) :group 'tab-bar - :version "29.1") + :version "30.1") -(defvar tab-bar-auto-width-min '(20 2) +(defvar tab-bar-auto-width-min '((20) 2) "Minimum width of tabs for automatic resizing under `tab-bar-auto-width'. The value should be a list of two numbers, giving the minimum width as the number of pixels for GUI frames and the number of characters for text-mode frames. Tabs whose width is smaller than this will not be narrowed. + +The first value may also be a list, as in `tab-bar-auto-width-max', +which see. + It's not recommended to change this value since with larger values, the tab bar might wrap to the second line when it shouldn't.") @@ -1207,6 +1221,18 @@ tab bar might wrap to the second line when it shouldn't.") (defvar tab-bar--auto-width-hash nil "Memoization table for `tab-bar-auto-width'.") +(defun tab-bar-auto-width-1 (wvalue) + "Return scaled value if WVALUE, if necessary. +If WVALUE is a list of the form accepted as pixel width specifications +by `tab-bar-auto-width-max' and suchlike, return its value as it should +be scaled for display on the current frame." + (if (consp wvalue) + (let ((height (frame-char-height))) + (if (< height 15) + (car wvalue) + (* (car wvalue) (/ height 15.0)))) + wvalue)) + (defun tab-bar-auto-width (items) "Return tab-bar items with resized tab names." (unless tab-bar--auto-width-hash @@ -1232,11 +1258,13 @@ tab bar might wrap to the second line when it shouldn't.") (length tabs))) (when tab-bar-auto-width-min (setq width (max width (if (window-system) - (nth 0 tab-bar-auto-width-min) + (tab-bar-auto-width-1 + (nth 0 tab-bar-auto-width-min)) (nth 1 tab-bar-auto-width-min))))) (when tab-bar-auto-width-max (setq width (min width (if (window-system) - (nth 0 tab-bar-auto-width-max) + (tab-bar-auto-width-1 + (nth 0 tab-bar-auto-width-max)) (nth 1 tab-bar-auto-width-max))))) (dolist (item tabs) (setf (nth 2 item) commit 4fa38af7c2dc1070e67530871a013abfaeee48c7 Author: Po Lu Date: Sat Jun 8 14:25:22 2024 +0800 Remove touchscreen pinch event generation threshold * lisp/touch-screen.el (touch-screen-handle-aux-point-update): Remove the said threshold. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 828810e7b33..dd6bbf8ccce 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1211,48 +1211,35 @@ last such event." (initial-distance (aref touch-screen-aux-tool 4)) (initial-centrum (aref touch-screen-aux-tool 5))) (let* ((ratio (/ distance initial-distance)) - (ratio-diff (- ratio (aref touch-screen-aux-tool 6))) - (diff (abs (- ratio (aref touch-screen-aux-tool 6)))) - (centrum-diff (+ (abs (- (car initial-centrum) - (car centrum))) - (abs (- (cdr initial-centrum) - (cdr centrum)))))) - ;; If the difference in ratio has surpassed a threshold of - ;; 0.2 or the centrum difference exceeds the frame's char - ;; width, send a touchscreen-pinch event with this - ;; information and update that saved in - ;; touch-screen-aux-tool. - (when (or (> diff 0.2) - (> centrum-diff - (/ (frame-char-width) 2))) - (aset touch-screen-aux-tool 5 centrum) - (aset touch-screen-aux-tool 6 ratio) - (throw 'input-event - (list 'touchscreen-pinch - (if (or (<= (car centrum) 0) - (<= (cdr centrum) 0)) + (ratio-diff (- ratio (aref touch-screen-aux-tool 6)))) + ;; Update the internal record of its position and generate an + ;; event. + (aset touch-screen-aux-tool 5 centrum) + (aset touch-screen-aux-tool 6 ratio) + (throw 'input-event + (list 'touchscreen-pinch + (if (or (<= (car centrum) 0) + (<= (cdr centrum) 0)) + (list window nil centrum nil nil + nil nil nil nil nil) + (let ((posn (posn-at-x-y (car centrum) + (cdr centrum) + window))) + (if (eq (posn-window posn) + window) + posn + ;; Return a placeholder outside the window + ;; if the centrum has moved beyond the + ;; confines of the window where the gesture + ;; commenced. (list window nil centrum nil nil - nil nil nil nil nil) - (let ((posn (posn-at-x-y (car centrum) - (cdr centrum) - window))) - (if (eq (posn-window posn) - window) - posn - ;; Return a placeholder - ;; outside the window if - ;; the centrum has moved - ;; beyond the confines of - ;; the window where the - ;; gesture commenced. - (list window nil centrum nil nil - nil nil nil nil nil)))) - ratio - (- (car centrum) - (car initial-centrum)) - (- (cdr centrum) - (cdr initial-centrum)) - ratio-diff)))))))) + nil nil nil nil nil)))) + ratio + (- (car centrum) + (car initial-centrum)) + (- (cdr centrum) + (cdr initial-centrum)) + ratio-diff))))))) (defun touch-screen-window-selection-changed (frame) "Notice that FRAME's selected window has changed. commit 00360258caddc0d8cf29ba3d9971125a06f8959b Author: Yuan Fu Date: Sat Jun 1 10:33:18 2024 -0700 Fix treesit-parse-string crash (bug#71012) Parsing a large file with treesit-parse-string and then printing the returned node crashes Emacs, because with-temp-buffer kills the temp buffer when treesit-parse-string returns, and print.c tries to access the node's position in the killed buffer. * lisp/treesit.el (treesit-parse-string): Don't use with-temp-buffer. diff --git a/lisp/treesit.el b/lisp/treesit.el index 2676ed932dc..151d9302786 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -122,10 +122,13 @@ of max unsigned 32-bit value for byte offsets into buffer text." (defun treesit-parse-string (string language) "Parse STRING using a parser for LANGUAGE. Return the root node of the syntax tree." - (with-temp-buffer - (insert string) - (treesit-parser-root-node - (treesit-parser-create language)))) + ;; We can't use `with-temp-buffer' because it kills the buffer when + ;; returning from the form. + (let ((buf (generate-new-buffer " *treesit-parse-string*"))) + (with-current-buffer buf + (insert string) + (treesit-parser-root-node + (treesit-parser-create language))))) (defvar-local treesit-language-at-point-function nil "A function that returns the language at point. commit 20af58d3a13ddb5c2ca376da8cdd3fde4833ca2d Author: Yuan Fu Date: Sat Jun 1 10:20:48 2024 -0700 Check for buffer liveness when accessing tree-sitter node (bug#71012) * src/treesit.h (treesit_node_buffer_live_p): Declare function. * src/print.c (print_vectorlike): Print node without position if buffer is killed. * src/treesit.c (treesit_node_buffer_live_p): New function. (treesit_check_node): Add buffer liveness check. (syms_of_treesit): New error treesit-node-buffer-killed. diff --git a/src/print.c b/src/print.c index d52d98ad371..8ee5a3616eb 100644 --- a/src/print.c +++ b/src/print.c @@ -2029,6 +2029,11 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_c_string ("-outdated>", printcharfun); break; } + if (!treesit_node_buffer_live_p (obj)) + { + print_c_string ("-in-killed-buffer>", printcharfun); + break; + } printchar (' ', printcharfun); /* Now the node must be up-to-date, and calling functions like Ftreesit_node_start will not signal. */ diff --git a/src/treesit.c b/src/treesit.c index 21c61a35e70..45efa429f9a 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -1786,6 +1786,13 @@ treesit_check_node (Lisp_Object obj) CHECK_TS_NODE (obj); if (!treesit_node_uptodate_p (obj)) xsignal1 (Qtreesit_node_outdated, obj); + + /* Technically a lot of node functions can work without the + associated buffer being alive, but I doubt there're any real + use-cases for that; OTOH putting the buffer-liveness check here is + simple, clean, and safe. */ + if (!treesit_node_buffer_live_p (obj)) + xsignal1 (Qtreesit_node_buffer_killed, obj); } /* Checks that OBJ is a positive integer and it is within the visible @@ -1806,6 +1813,14 @@ treesit_node_uptodate_p (Lisp_Object obj) return XTS_NODE (obj)->timestamp == XTS_PARSER (lisp_parser)->timestamp; } +bool +treesit_node_buffer_live_p (Lisp_Object obj) +{ + struct buffer *buffer + = XBUFFER (XTS_PARSER (XTS_NODE (obj)->parser)->buffer); + return BUFFER_LIVE_P (buffer); +} + DEFUN ("treesit-node-type", Ftreesit_node_type, Streesit_node_type, 1, 1, 0, doc: /* Return the NODE's type as a string. @@ -3549,6 +3564,8 @@ syms_of_treesit (void) "treesit-load-language-error"); DEFSYM (Qtreesit_node_outdated, "treesit-node-outdated"); + DEFSYM (Qtreesit_node_buffer_killed, + "treesit-node-buffer-killed"); DEFSYM (Quser_emacs_directory, "user-emacs-directory"); DEFSYM (Qtreesit_parser_deleted, "treesit-parser-deleted"); @@ -3577,6 +3594,9 @@ syms_of_treesit (void) define_error (Qtreesit_node_outdated, "This node is outdated, please retrieve a new one", Qtreesit_error); + define_error (Qtreesit_node_buffer_killed, + "The buffer associated with this node is killed", + Qtreesit_error); define_error (Qtreesit_parser_deleted, "This parser is deleted and cannot be used", Qtreesit_error); diff --git a/src/treesit.h b/src/treesit.h index f5c8c67395d..dcb19648a37 100644 --- a/src/treesit.h +++ b/src/treesit.h @@ -189,6 +189,7 @@ extern Lisp_Object make_treesit_parser (Lisp_Object, TSParser *, TSTree *, extern Lisp_Object make_treesit_node (Lisp_Object, TSNode); extern bool treesit_node_uptodate_p (Lisp_Object); +extern bool treesit_node_buffer_live_p (Lisp_Object); extern void treesit_delete_parser (struct Lisp_TS_Parser *); extern void treesit_delete_query (struct Lisp_TS_Query *);